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SUMMARY 

Noise from a J-85 turbojet with a conical, convergent 
nozzle was measured in simulated flight in the ONERA 
SI Wind Tunnel. Data are presented for several flight 
speeds up to 130 m/sec and for radiation angles of 40° to 
160° relative to the upstream direction. The jet was oper- 
ated with subsonic and sonic exhaust speeds. A moving 
microphone on a 2-m sideline was used to survey the 
radiated sound field in the acoustically treated, closed test 
section. The data were extrapolated to a 122-m sideline by 
means of a multiple-sideline source-location method, 
which was used to identify the acoustic source regions, 
directivity patterns, and near field effects. The source- 
location method is described along with its advantages 
and disadvantages. 

Results indicate that the effects of simulated flight on 
J-85 noise are significant. At the maximum forward speed 
of 130 m/sec, the peak overall sound levels in the aft 
quadrant were attenuated approximately 10 dB relative to 
sound levels of the engine operated statically. As 
expected, the simulated flight and static data tended to 
merge in the forward quadrant as the radiation angle 
approached 40°. There is evidence that internal engine or 
shock noise was important in the forward quadrant. The 
data are compared with published predictions for flight 
effects on pure jet noise and internal engine noise. A new 
empirical prediction is presented that relates the variation 
of internally generated engine noise or broadband shock 
noise to forward speed. Measured near field noise extrap- 
olated to far field agrees reasonably well with data from 
similar engines tested statically outdoors, in flyover, in a 
wind tunnel, and on the Bertin Aerotrain. Anomalies in 
the results for the forward quadrant and for angles above 
140° are discussed. 

The multiple-sideline method proved to be cumber- 
some in this application, and it did not resolve all of the 
uncertainties associated with measurements of jet noise 
close to the jet. The simulation was complicated by wind- 
tunnel background noise and the propagation of low- 
frequency sound around the circuit 

1 Research Engineer, ONERA (Office National d Etudes 
et de Recherches Adrospatiales). 


INTRODUCTION 

In the fall of 1979, a NASA/ONERA joint research 
study of jet noise was conducted in the ONERA SI Wind 
Tunnel at Modane-Avrieux, France. The objective of the 
program was to measure the near-field noise of a General 
Electric J-85 jet engine at flight speeds greater than those 
previously attained in the NASA Ames 40- by 80-Foot 
Wind Tunnel and to extrapolate the data to the far field in 
order to identify forward speed effects on the jet noise. 
The data were to be compared to existing flight data. At 
the same time, ONERA desired to know (1) if the closed 
test section of the SI Wind Tunnel could be adequately 
treated with acoustic linings to provide the proper acoustic 
environment for this type of research, and (2) which of 
several experimental techniques properly identified the 
noise source locations in the jet exhaust. The source - 
location techniques evaluated were (1) traversing sideline 
microphones, (2) acoustic antennas, and (3) infrared 
detectors; only the first technique is described in this 
report. Reference 1 describes the results of the infrared 
detector measurements. 

The J-85 engine was chosen for this study because an 
extensive data base has been acquired for it by indepen- 
dent researchers over several years. The J-85 jet noise was 
measured statically (refs. 2 and 3), in flight (refs. 4-7), on 
a low-noise train (refs. 8-10), and in the Ames 40- by 
80-Foot Wind Tunnel (refs. 11-14) before the acoustic 
treatment of the test section. This data base was important 
for checking the results of the present study because, 
despite the satisfactory extrapolation, in a number of 
studies, of near field to far field jet noise from scale 
models (refs. 15-18), the analysis and extrapolation of 
full-scale engine noise with its multiplicity of sources is a 
difficult task. Furthermore, the near field data were 
acquired only 2.0 m from the jet axis, thus data interpre- 
tation is difficult. 

Strout and Atencio (refs. 19-21) found good agree- 
ment between extrapolated near field data and far field 
data for a JT8D jet engine using the multiple-sideline 
source-location technique. However, their methods 
required manual fairing and extrapolation of the data at 
stages in the data processing, which required some 
knowledge of probable results gained from experience 
with jet noise. Our study involves an extension of Strout 


and Atencio’s techniques in which the data reduction is 
completely automated in a consistent manner and does not 
require manipulation of the data at various steps in the 
algorithm. 

The SI Wind Tunnel was used for this study because 
of its large speed range (0 to Mach 1) and large (8-m- 
diameter) test section. It was hoped that if the various dif- 
ficulties with near field effects, background noise, and 
reflections could be dealt with, the advantages of high 
windspeed would lead to a better simulation of forward- 
speed effects than was possible in the lower-speed Ames 
40- by 80-Foot Wind Tunnel (ref. 1 1). To cope with the 
anticipated acoustical problems, ONERA developed an 
elaborate test-section lining based on NASA’s recom- 
mendation; that lining is described in this report. NASA 
provided the computer software developed for jet noise 
source location and extrapolation based on multiple- 
sideline noise measurements. (This software was subse- 
quently improved by ONERA.) This report concentrates 
on the source-location technique and its results. The tech- 
nique is based on the hypothesis that by mapping jet noise 
along two lines parallel to the jet it is possible, with 
certain manipulations of the data, to extrapolate to the jet 
and identify the apparent noise source regions at each 
frequency, as well as the radiation direction of the 
sources. Assumptions must be made about propagation 
decay and so-called near field effects. The noise can then 
be extrapolated to the far field. This report describes the 
techniques used, their advantages and disadvantages, and 
forward-speed effects on the jet and engine noise. 

NOMENCLATURE 

c sound speed in ambient air, m/sec 

d ejector exhaust-nozzle diameter, 0.44 m 

f frequency, Hz 

Lp sound pressure level, dB re 2x1 0 -5 N/m 2 

M jet relative Mach number, 0.62(Vj - Va)/c 

Mq flight Mach number, VJc 

R distance from noise source location to 

observer, m 

Sto Strouhal number (static case), fd/Vj 

St Strouhal number with wind, fd/(Vj - Va) 


T t jet total temperature at primary exhaust 

nozzle, °C 

V a windspeed in test section or free stream, 

m/sec 

Ve effective jet exhaust speed, 

Vj(l - Vj/Vj) 2/ -\ rn/sec 

Vj jet exhaust speed at the primary nozzle exit 

(fig. 1), m/sec 

X distance along the jet centerline from 

exhaust nozzle to acoustic source, without 
wind, m 

X' distance along the jet centerline from 

exhaust nozzle to acoustic source, with 
wind, m 

Y i perpendicular distance from shear layer to 

near sideline, m (shear layer assumed to be 
at exhaust nozzle radius) 

Y2 perpendicular distance from shear layer to 

far sideline, m 

ALp difference or change in jet noise level, dB 

ALpj difference or change in internal engine noise 

level, dB 

ALpfc kinematic effect on jet noise due to motion 
of airplane relative to observer, dB 

a normal incidence absorption coefficient 

X acoustic wavelength, m 

VI angle between jet axis and line connecting 

exhaust nozzle center and observer on near 
sideline, with wind, deg 

V2 angle between jet axis and line connecting 

exhaust nozzle center and observer on far 
sideline, with wind, deg 

Vs angle between jet axis and acoustic radiation 

vector connecting acoustic source and 
observer, with wind, deg 

01 angle between jet axis and line connecting 

exhaust nozzle center and observer on near 
sideline, without wind, deg 
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02 angle between jet axis and line connecting 

exhaust nozzle center and observer on far 
sideline, without wind, deg 

0 S angle between jet axis and acoustic radiation 

vector connecting acoustic source and 
observer, without wind, deg 

p a density of ambient air, kg/m 3 

Pj density of fully expanded jet, kg/m 3 

Subscripts 


1 near sideline microphone traverse, or condi- 
tion 1 flight and jet speed 

2 far sideline microphone traverse, or condi- 
tion 2 flight and jet speed 


TEST EQUIPMENT AND METHODS 


Jet Engine 

The General Electric J-85 engine is a small turbojet 
with a maximum net thrust of 12,100 N, a maximum mass 
flow rate of 20 kg/sec, a maximum exhaust pressure ratio 
of 2.4, and an exhaust diameter of 0.44 m. The engine was 
operated with four nozzles: (1) a conical nozzle with ejec- 
tor, (2) a variable flap ejector; (3) a 104-tube mixer sup- 
pressor nozzle; and (4) a 104-tube mixer suppressor 
nozzle with ejector. Only the conical nozzle with ejector 
made sufficient noise at all frequencies to dominate the 
wind tunnel background noise at the windspeeds used in 
this study; therefore data for the other nozzles will not be 
shown. 

Figures l(a)-l(c) show the engine geometry, includ- 
ing the convergent, primary exhaust nozzle and secondary 
cylindrical ejector. The cylindrical ejector had a blunt 
base, which was used in previous studies in which exter- 
nal pressure drag could be measured accurately (ref. 4). 
The ejector was designed to pump ambient air equal to 
only 5% of the primary flow for cooling purposes, and 
had no thrust augmentation; nor could the ejector be con- 
sidered a mixing nozzle for enhanced jet decay and noise 
reduction. Moreover, the conical ejector nozzle diameter 
of 444 mm was used as the reference dimension for 
normalization of the distances used in the acoustic study. 
The primary exhaust nozzle was used as the reference for 
computation of jet thrust and velocity. 


case a low-speed airflow in the wind tunnel was induced 
by the engine. 

Table 1 shows typical jet exhaust velocities, tempera- 
tures, momentum thrust, and pressure ratios used in this 
study. The jet was operated both subsonically and with 
sonic conditions at the primary exhaust nozzle. The jet 
pressure ratio was calculated from the ratio of total pres- 
sure in the jet to test-section static pressure. (The flow 
conditions at the primary nozzle were extrapolated from 
measurements made upstream (ref. 5).) At pressure ratios 
greater than 1.85, the flow at the primary exhaust reached 
sonic speeds. At higher pressure ratios, it is probable that 
a shock system existed downstream from the primary 
exhaust. 

Although it was equipped with an afterburning duct, 
the engine was operated without afterburning. 

SI Wind Tunnel 

The SI Wind Tunnel at Modane-Avrieux (ref. 22) is 
a closed-circuit, continuous-operation, sonic wind tunnel 
with a test section speed range to Mach 1. Figure 2 is a 
schematic of the wind tunnel. The interchangeable, closed 
test section used in this study was 8 m in diameter and 14 
m long. Two counterrotating fans are located in the 
crossleg downstream of the primary diffuser. There are no 
acoustic silencers in the wind tunnel circuit. The altitude 
of the wind tunnel is 1 100 m. 

Test Section Lining 

The entire cylindrical test section was lined for this 
test with a 125-mm-thick absorbent lining composed of 
75-mm polyurethane foam and a 50-mm air space as 
shown in figure 3. The outer 20 mm of foam was treated 
with chemical fire retardant. The foam was supported by a 
porous metal screen embedded 60 mm from the flow sur- 
face, and was backed by a perforated plastic film which 
improved the mid-frequency absorption. The air gap 
between the foam and the wall contributed to the low- 
frequency absorption illustrated in figure 4, which shows 
the acoustic absorption of the composite lining with 30- 
and 50-mm air gaps. The data were acquired with a stand- 
ing-wave tube. The absorption was very good above 
300 Hz. During the initial checkout in the wind tunnel, 
some of the panels started to vibrate badly when the 
windspeed reached 130 m/sec An improved fastening 
technique solved this problem. 


A flight inlet was used for both static and forward 
flight operation of the engine, because even in the static 
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Model Installation 

Figure 1(a) is a photograph of the J-85 engine and 
ceiling-mounted support strut in the test section. Figures 
5(a) and 5(b) show the installation geometry. The center 
of the engine was 1.5 m above the center of, and on the 
vertical centerplane of, the test section. 

Acoustic Instrumentation 

Figures 5(a) and 5(b) illustrate the moving micro- 
phone traverse parallel to the jet axis. Two carriages were 
used, each equipped with two pairs of microphones. One 
microphone of each pair was the primary data micro- 
phone; the other was a backup. Four microphones (1, 2, 3, 
and 4) were traversed 2.0 m from the jet centerline, and 
four microphones (5, 6, 7, and 8) were traversed 3.5 m 
from the jet centerline. The two rails were in line such that 
the upstream carriage with microphones 1, 2, 5, and 6 tra- 
versed 6.7 m from the J-85 inlet to a point just down- 
stream of the exhaust nozzle, and the second carriage with 
microphones 3,4,7, and 8 continued along the jet exhaust 
another 6.7 m. This arrangement allowed a sweep of the 
jet noise radiation relative to the exhaust center of 40° to 
165° at the 2.0-m sideline and 56° to 155° at the 3.5-m 
sideline, 0° being the upstream direction. The microphone 
carriage and rail were streamlined and curved for mini- 
mum acoustic reflection, but they were not acoustically 
treated. The microphones with nose cones were pointed 
upstream and were essentially omnidirectional. The 
carriages moved simultaneously and took approximately 
three minutes to complete the traverse. An optical device 
tracked the carriage position to the nearest millimeter. 

The guy wires shown in Figure 5(b) were used to 
secure the microphone arrays. They generated a tone near 
2.5 kHz, but the tone is not visible in the third-octave 
band spectra. 

Also shown in figure 5(a)-5(c) is the fixed array of 
48 microphones, 3.2 m from the jet axis, used by ONERA 
to locate acoustic sources by means of antenna signal pro- 
cessing. In addition, eight of the microphones with 15-cm 
spacing and eight microphones with 30-cm spacing were 
connected to an electronic time-delay system developed at 
Ames to create two eight-channel broadside antennas (ref. 
23). A broadside antenna parallel to a jet can be focused 
on a region of the jet and reject sound arriving from 
upstream or downstream, to varying degrees, depending 
on the number of array elements. The antenna cannot, 
however, discriminate in the vertical plane to reject floor 
or ceiling reflections. The antennas were focused on 
various parts of the jet exhaust for on-line analysis of the 


jet noise. (The data for this analysis are not reported here.) 
The other data systems were processed off line. 

The moving microphone data were recorded on ana- 
log recorders with appropriate time-code signals so that 
analysis in third-octave bands could be made of the sound 
as a function of position. Amplifier gain for each channel 
was set automatically and then locked just before a 
traverse. Gain was recorded on each channel using a fre- 
quency code. Test number, run number, date, microphone 
number, and wind tunnel identification were recorded on 
each data channel as a pulse code interpreted as binary 
numbers. The third-octave band data were digitized after 
the test and input to the source-location/extrapolation 
computer program to be described. 

Engine Instrumentation 

Knowledge of the engine performance was required 
to evaluate the acoustic data. The J-85 was instrumented 
for (1) total pressures upstream and downstream of the 
compressor, (2) temperatures downstream of the compres- 
sor, (3) fuel flow rate, and (4) engine rotational speed. 
The instruments provided fluid mechanics data sufficient 
for the computation of thrust, mass-flow rate, and jet 
exhaust velocity. The instrumentation is described in 
reference 5. 

Test Procedure and Limits of Variables 

The first data sets were obtained during static opera- 
tion of the engine in the wind tunnel. Because of tempera- 
ture limitations of certain engine components, the maxi- 
mum engine speed attained was 16,170 rpm (98% of the 
maximum rated rpm), which produced a maximum jet exit 
velocity of 545 m/sec during static operation and 
606 m/sec at forward speed. Operation of the engine 
induced a relatively small but significant airflow in the 
wind tunnel of 16 m/sec maximum. Acoustic data were 
taken at several windspeeds, up to a maximum of 
130 m/sec. The windspeed was limited by the allowable 
loads on the acoustic lining. Nonetheless, the maximum 
speed was significantly greater than the maximum speed 
of 91 m/sec previously attained in the Ames 40- by 
80-Foot Wind Tunnel. (Since these tests, the maximum 
speed in the 40- by 80-Foot Wind Tunnel has been 
increased to 155 m/sec.) 

The general procedure was to set the wind tunnel and 
engine speed, take data while the microphones were 
traversing downstream, and then increase the engine 
speed while moving the microphones back to their starting 
positions upstream. Background noise was measured with 
the engine in the test section but not operating. 
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Data Analysis 

Extrapolation to the far field of noise levels measured 
close to a large distribution of noise sources such as a jet 
exhaust would be hopeless without some knowledge of 
the source regions and their directional properties as func- 
tions of frequency. Different researchers have employed a 
variety of experimental techniques for identifying the 
source regions of jets, including use of acoustic antennas, 
focusing reflectors, cross correlation, infrared detectors, 
and in-flow probes. The multiple-sideline source-location 
technique (ref. 16) was developed on the premise that a 
proper map of the acoustic field at two distances from a 
jet contains enough information to describe how and from 
where the sound is propagating. Once this information is 
known, a single map of the sound field can be used to 
extrapolate the jet noise to any distance. To apply the 
method to this project, the following steps were taken. 

1. The jet noise was recorded along two lines paral- 
lel to the jet axis, at locations 2.0 m and 3.5 m from the jet 
axis, as shown in figures 5 and 6. The traverse lines and 
the jet were nearly in the same plane. The 2.0-m and 
3.5-m sideline data from the SI Wind Tunnel study could 
have been used for determination of source locations had 
it not been for a small acoustic interference resulting, we 
suspect, from low-frequency propagation around the 
circuit. The acoustic lining did not absorb well at low 
frequencies, and low-frequency sound propagates well in 
wind tunnels. Consequently, low-frequency noise mea- 
sured upstream of the jet was louder than it should have 
been. Because of this problem, noise data from the same 
engine operated statically at the Ames outdoor test site 
(ref. 2), recorded at 2.0-m and 1 2.0-m sidelines (measured 
from the jet centerline), were used for the source-location 
part of the analysis. The data were acquired with slowly 
traversing microphones. Details of the engine and micro- 
phone data acquisition are given in reference 2. 

Despite the small amplification in the SI Wind 
Tunnel, the SI data and the Ames outdoor data agree 
fairly well, as illustrated in figure 7, which shows overall 
sound levels measured on a 2-m sideline at ONERA and 
at Ames. The figure also shows the Ames data corrected 
to the same jet speed and forward velocity condition 
(from wind-tunnel flow induced by the engine) as in the 
SI, using the method of reference 24. (This method will 
be discussed further in the Results and Discussion 
section.) The SI data rise above the Ames data at small 
radiation angles, to a maximum of 3 dB at 40°. This same 
trend was seen in data obtained by other experimenters. 
At large angles, the jet was strong and it dominated most 
contaminations. At small radiation angles, upstream of the 
exhaust, the low-level sound at low frequencies was con- 


taminated by the jet noise which radiated downstream and 
traveled around the circuit. In any case, this effect would 
be generally similar with wind or without wind, so that 
the measured change in jet noise caused by flight (i.e., 
flight noise minus static noise) should be relatively 
unaffected. 

The difference between the SI and Ames data shown 
in figure 7 was subtracted from certain S 1 directivity plots 
(figs. 21-24) (see Results and Discussion). This correction 
ranged from 0 dB at Y2 = 135° to 3 dB at y 2 = 40° for 
overall sound levels. Similar comparisons in third-octave 
bands showed somewhat larger differences at low 
frequencies and somewhat smaller differences at high fre- 
quencies (see table 2). The source of the high-frequency 
amplification in the SI is unknown. The third-octave band 
plots in figures 21(a)-2(f) were corrected for the amplifi- 
cations listed in table 2. 

2. The acoustic data were averaged and converted 
to third-octave band spectra at specific angles relative to 
the engine exhaust. Because the microphones were con- 
tinuously moving, the maximum averaging time was 2 sec 
for a particular angle, leaving some scatter in the spectra 
(e.g., third-octave analysis of stationary Gaussian noise at 
250-Hz and 2-sec integration time results in ±1 dB accu- 
racy for 99% confidence; scatter is less for higher 
frequencies, more for lower frequencies or nonstationary 
noise). The data were also corrected for microphone 
frequency response by increasing the measured sound 
level where the response was low, and vice versa. Next, 
the spectra were smoothed by fitting an 8th-degree poly- 
nomial to the data. Figure 8 shows typical data at the 
2.0-m sideline before and after the curve fit. 

3. The acoustic spectra were then replotted as third- 
octave band levels versus exhaust-microphone angle at 
each frequency. It was again necessary to smooth the 
curves with an 8th-degree polynomial, because the 
source-location method requires well defined peaks in the 
noise-directivity plots. Any anomalous peaks resulting 
from data scatter complicated the extrapolation, especially 
since the operation was done automatically by the 
computer. 

From static data acquired at Ames (ref. 2), such as 
those plotted in figures 9(a) and 9(b), pairs of angles were 
found which define the propagation direction at each fre- 
quency. That is, it is assumed that the far field peak in the 
directivity plot was generated by the same acoustic ray 
that passed through the near field peak. Similarly, it is 
assumed that each segment of the far field plot is related 
to a particular segment of the near field plot by the same 
noise difference that was found for the peaks. This is 
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illustrated graphically in figures 9(a) and 9(b). Thus, for 
each third-octave frequency band and each far field angle 
there is a corresponding near field angle through which 
the sound ray at that frequency passes. In other words, a 
sound ray propagating from the jet would pass through the 
near and far sidelines at two points along that ray which 
can be described by a specific pair of angles 0i and 02 . 

This procedure can break down, however, if the far 
field and near field curves tend to converge, which some- 
times happens at high frequencies and low directivity 
angles as shown in figure 9(b). In this case, one cannot 
find an appropriate noise difference at low angles equal to 
peak noise difference, as one can in figure 9(a). The 
anomalous rise in the far field curve (fig. 9(b)) would 
cause the computer to find a noise difference for an illogi- 
cal angle pair, which would result in an incorrect source 
location. It would be tempting to refair the lower curve of 
figure 9(b) at low angles to force the angle pairs to some 
“appropriate” values, but this adjustment is not justified 
by the data and was not done. 

Figure 10 illustrates the peak noise radiation angle 
plotted versus Strouhal number as measured at Ames and 
in the SI Wind Tunnel. There was reasonably good 
agreement between the Ames and SI data at similar jet 
exhaust speeds. As expected, there was a tendency for the 
higher frequency sound to radiate at smaller angles than 
the low frequency sound did. 

4. Tracing the acoustic ray at each frequency back 
to the jet defines static source locations shown, for exam- 
ple, in figures 1 1(a) and 1 1(b) for two Strouhal numbers. 
Figures 1 1(a) and 1 1(b) are from the Ames static test of 
reference 2. It was assumed that the sources were located 
in the near shear layer, one nozzle radius from the center- 
line. This arbitrary definition of a source center is an 
obvious simplification of a complicated phenomenon 
because it says nothing about source distribution or multi- 
ple locations in the jet radiating noise to the same point in 
space. 

The source-location method does not require that all 
sound at a given frequency must originate from the same 
point in the jet. The data show that a range of source 
locations at one Strouhal number (or frequency) radiate 
sound at different angles. Note that in most cases, lower 
frequency sound and sound radiated at large angles tend 
to originate farther downstream than high-frequency or 
low-angle sound do, which is consistent with results in 
reference 16. Figures 12(a) and 12(b) are a comparison of 
source locations measured at Ames and in the SI Wind 
Tunnel for the static case. At radiation angles 0 S > 60° and 
frequencies above 500 Hz, the agreement is reasonably 


good. At low frequencies and low radiation angles, the 
suspected SI acoustic contamination distorted the compu- 
tation of the source locations. For this reason, the Ames 
data were used for this phase of the data analysis. 

5. Once the source locations and radiation angles 
for a given frequency or Strouhal number are found, the 
data measured anywhere in the field, usually in the near 
field, can then be extrapolated to any far field distance. 
This extrapolation, however, is the weakest part of the 
method because, as experience has shown, the near field 
noise levels are always less than one would get by mea- 
suring in the far field and extrapolating back to the near 
field point using spherical radiation (6 dB per double 
distance plus correction for atmospheric effects). This 
deficiency may be a large-scale-jet effect; Ahuja et al. 
(ref. 15) reported no near field effect for a small-scale jet 
(2 . 54 -cm -diameter nozzle) when the source locations and 
noise directivities were identified. However, the near field 
effect is consistent with the concept of distributed or finite 
line sources with sound fields that decay at 3 dB per 
double distance out to a particular radius and 6 dB per 
double distance beyond that, neglecting atmospheric 
absorption. 

Without information on the extent of the distributed 
sources, the decay rate cannot be known even if the 
source center is known. To extrapolate the sound to a spe- 
cific point, one must develop a so-called near-field 
correction. This near field correction is simply the differ- 
ence at the near sideline between the measured levels and 
the levels extrapolated from a far field sideline using 
spherical decay and atmospheric absorption. The correc- 
tion requires the operation of the engine outside the wind 
tunnel to get far field data. 

Figure 13 illustrates typical near field correction 
curves measured with the conical nozzle and various jet 
velocities acquired at Ames in the study described in 
reference 2. The data collapse to a single curve when 
plotted versus the nondimensional parameter (RA)(Vj/c), 
in which R is the distance to the near field measurement 
point The correction should change with nozzle type. It is 
not known if these near field corrections found statically 
hold true for the jet in flight Since the jet core probably 
stretches in flight, the noise source distributions possibly 
change enough to affect the near field correction. 

& The source location, X, and radiation angles, 0 S , 
acquired statically must be corrected for convection 
effects in the wind tunnel (ref. 2), as illustrated in fig- 
ure 14. The notations for the static parameters X, 0 S , 0j, 
and 02 become, with wind, X', y s , and \|/2, respec- 
tively. It is assumed that the wind causes the jet core to 
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stretch, moving the noise sources downstream. This effect 
is handled by redefining the Strouhal number of each 
source location plot so that (ref. 16) 

St = fd/(Vj-V.) (1) 

Equation (1) is somewhat arbitrary in that it implies that 
the movement of noise sources downstream in the jet (or 
stretch) because of ambient wind is equivalent to increas- 
ing the source frequency (or Strouhal number) at any 
fixed point in a coordinate system fixed to the engine. 
This is probably based on evidence that high-frequency 
sources are closer to jet exhaust nozzles than low-fre- 
quency sources are. Hence, at a given location in the jet, 
increasing forward speed will cause high-frequency 
sources to move downstream and to displace the lower 
frequency source that was there. Equation (1), therefore, 
is an estimate of how those source frequencies (or 
Strouhal numbers) change. 

In the source-location method, it is assumed that as 
wind increases, the static plots of source location versus 
radiation angle are perfectly valid for wind-on conditions, 
at the appropriate Strouhal numbers given by equation (1). 
Although this reasoning agrees with experimental trends, 
the exact relationships between forward speed, source 
movement, source radiation, and source Strouhal number 
have not been verified except by the comparisons between 
the final extrapolated noise field and far field data (as will 
be discussed). Furthermore, these source convection 
effects are valid only for pure jet noise sources and are not 
valid for other sources fixed to the engine such as 
combustion noise, turbomachinery noise, or (possibly) 
shock noise. 

In the wind tunnel, sound waves generated during 
simulated flight are swept downstream and the new source 
radiation angle is defined as (ref. 13) 

\|f s = tan“ 1 |[sin(0 g - 90°) + V a / c] / [cos(0 s - 90°)] J + 90° 

( 2 ) 

Convection of sound waves in a wind tunnel relative to 
the engine is equivalent, with respect to direction, to the 
movement of the aircraft in flight away from the propagat- 
ing sound waves. So, for a coordinate system fixed to the 
aircraft, the acoustic field directivity pattern is the same in 
both cases. 

Figures 15 (a)- 15(d) show jet noise source locations 
with wind that were deduced from static source locations 


by means of the above equations. Those results indicate 
that, at a given Strouhal number, a range of source loca- 
tions radiate sound over a range of angles. 

7. With the above information, it was then possible 
to correct the SI Wind Tunnel data for near field effects, 
and then extrapolate to far field. For a given frequency 
and location along the 2.0-m sideline, the convected 
source locations and radiation angles were examined until 
a source location and radiation angle were found that cor- 
responded to an acoustic ray propagating through the 
measurement point. The corrected wind-tunnel data were 
then extrapolated to the desired far field sideline along 
that ray using spherical decay and atmospheric decay. 
Table 3 shows typical data, corrections, and extrapola- 
tions. Figures 16(a) and 16(b) illustrate typical 2.0-m data 
and extrapolated results at the 122-m sideline. The accu- 
racy of the extrapolation is very sensitive to the accuracy 
of the source location. A source position error equal to 
one nozzle diameter can lead to a far field radiation angle 
(0 S or y s ) error of up to 12° for that source. 

The computer code developed to perform all the 
corrections, curve fits, calculations, extrapolations, and 
plotting is complex. Figure 17 illustrates the flow of 
information required to carry out the numerous operations 
automatically. Reference 25 describes the function of each 
module of the code as it was developed to operate on the 
ONERA computer systems. Appendixes A and B contain 
the computer code listings for the main programs, 
NOISE3 and NOISE4. NOISE3 calculates the source 
location with the wind off, and NOISE4 calculates the far 
field directivity and wind effects. 

RESULTS AND DISCUSSION 

Background Noise 

Figures 18(a)- 18(c) show typical background noise 
levels measured at the 2.0-m sideline in the SI Wind 
Tunnel for windspeeds of 87, 113, and 130 m/sec. The 
data are presented as sound pressure level in third-octave 
bands versus angle relative to the nozzle exit center (0° is 
upstream, 180° is downstream). This is the typical format 
for this report. Sound pressure level peaks at around 
114 dB. The noise levels appear to be dominated by flow 
interaction with the microphones and support fairings. 
These levels are sufficiently below the jet noise levels as 
to be negligible. Since the 3.5-m-sideline jet noise data 
were contaminated by background noise at high wind- 
speeds, none of the 3.5-m data are presented in this report 
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Extrapolation to Far Field 

Figures 19(a)— 19<j) show the 2.0-m-sideline jet noise 
levels in the SI Wind Tunnel and the corresponding 
extrapolated noise at the 122-m sideline for windsp eeds of 
49, 72, 88, 1 13, and 130 m/sec. The 2.0-m data show peak 
noise levels at 400-630 Hz and peak radiation angles of 
155°-160°. At 122 m the noise peaks at 400-500 Hz and 
radiation angles of 142°-160°, which is appropriate for 
source locations about two nozzle diameters downstream 
of the exhaust (see fig. 15(b)). In other words, a sound ray 
originating in the shear layer two nozzle diameters down- 
stream of the exhaust and passing through the 2.0-m side- 
line with an angle, \\f i, of 155°-160° will arrive at a 
122-m sideline with an angle, of 149°-156°, accord- 
ing to the geometry (see fig. 14). 

The data in figures 19(a)— 19(j) are plotted directly 
from the automatic data-reduction program and have 
obvious discontinuities which appear at some high 
frequencies and high angles. The discontinuities are the 
result of rapid, fictitious changes in apparent source loca- 
tions. For example, the discontinuity in the 8-kHz curve in 
figure 19(0 can be traced to the scattered source locations 
at 8 kHz in figure 15(d). These abnormal source locations 
are created by anomalies in the spectra used to find the 
angle pairs (figure 9(b), for example), which the computer 
code treats impartially. However, the resulting error in the 
extrapolations of figure 19 have a negligible effect on the 
overall noise levels. 

Internal Engine or Shock Noise 

It is important to note that at the higher jet speeds, 
there is evidence that internal engine noise or broadband 
shock noise is dominating the near field jet noise at low 
directivity angles and midfrequencies, but it is not clear 
which of the two noise sources is dominant Figures 19(g) 
and 19(i), for example, show peaks, or lobes, in the near 
field directivity pattern between 60° and 120° (hat are 
obviously not caused by pure jet noise. When these noise 
lobes are extrapolated to far field, only the lobe at around 
120° is clearly visible (figs. 19(h) and 19(j)). 

The changes in noise with jet speed for 1.0 kHz and 
1.2 kHz are plotted in figure 20, which illustrates the rapid 
growth of internal or shock noise in the near field and the 
slower growth in the far field. Although the data set is 
limited, the curves indicate that in this operating regime, 
the near field or shock noise increased with jet speed 
(neglecting differences in forward speed), as 

ALpj = 10 log( V j2 / Vjj) 24 (3) 


and the far field internal and jet noise increased, as 

ALp= 10 log(Vj 2 / Vj]) 5 (4) 

This apparent contradiction in growth rates can only be 
possible if the near field microphone was dominated by a 
nearby internal or shock noise source when the micro- 
phone passed upstream of the exhaust nozzle. In that 
region, the jet turbulence noise is relatively weak and the 
internal or shock source strength grows rapidly with jet 
speed. In the far field, however, the microphone is about 
equidistant from sources throughout the jet, and the radi- 
ation angle is larger so that jet noise is strong, yet growing 
at a slower rate than internal noise. As jet speed increases, 
however, the proportion of far field noise caused by inter- 
nal or shock sources must increase. When one type of 
source dominates both the near and far acoustic fields, the 
near field and far field growth rates with increase in jet 
speed will be identical. 

Thus, the J-85 far field directivity pattern at midfre- 
quencies tends to have two major lobes, one near 160°, 
caused by pure jet noise, and one near 120°, which 
appears to be influenced by internal or shock noise. This 
latter observation is supported by Stone’s plot in refer- 
ence 26 of internally generated noise directivity from 
many full-size jet engines. This plot shows a broad peak 
that reaches 120° and has a shape very similar to the mid- 
to high-frequency data plotted in figure 19. Internally 
generated noise could also be important at angles lower 
than 120°, where the jet noise is relatively weak. These 
two lobes are not clearly seen in the overall sound-level 
directivity plots. 

Forward Speed Effects 

We can now compare the data of figures 16 and 19 to 
show the effects of forward speed on jet noise. Fig- 
ures 21 (a)-2 1(e) show the flight effects on the overall 
sound pressure levels at the 122-m sideline for speeds of 
49, 72, 88, 113, and 130 m/sec. 

Corrections 

All curves in figures 21(a)-21(e) were corrected 
equally for the 0-3-dB amplification in the SI Wind Tun- 
nel described in the data analysis section. Because the 
static data were recorded with an induced windspeed of 
16 m/sec in the wind tunnel and a jet speed of 545 m/sec, 
it was also necessary to correct the far field static data to 
zero windspeed and to the correct flight jet speeds noted 
in figures 21(a)-21(e). Both original and corrected curves 
are shown. These corrections were taken from the 
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semi-empirical jet noise prediction of Stone et al. in refer- 
ence 24 , and ranged from less than 1 dB in figure 21(a) to 
a maximum of 6.6 dB at 140° in figure 21(e). The change 
in jet noise due to a change in jet and/or flight speed is 
given by 

ALp = Lp 2 - Lp] = 10 log(pj 2 / p a ) W2 - 10 log(pj, / p a ) Wl 

+10 log(V e2 / V el ) 7 5 - 15 log(K 2 / K,) ( 5 ) 

where ALp is the change in noise for any change in flight 
speed or jet speed, represented by “condition 1” (Lpi) or 
“condition 2” (Lp2). For each condition, the following 


parameters are computed. 


/ \ 2/3 

V c = V j (l-V a V j ) 

(6) 

w = 3(V e c) 3 ' 5 /[o.6 + (V e /c) 3 ' 5 

-1 (7) 

K = [l + M cos( V 2 )f + 0.04M 2 

(8) 

M = 0.62(Vj-V a )/c 

(9) 


Equation (5) gives the change in overall noise due to the 
change in jet speed and flight speed of a simple isolated 
jet parallel to the flight direction. Internal engine or shock 
noise sources are not included. The dynamic effect on 
sound amplitude of the change in relative motion between 
the source and the propagation medium is included, but 
the kinematic effect of relative motion between aircraft 
and observer is not included since there is no such motion 
in the wind tunnel. The kinematic effect is small; an esti- 
mation of it is given in the section “Comparisons with 
Predictions”. It was deduced from the results of refer- 
ence 24 that, to a first approximation, equation (5) is also 
valid for third-octave band frequencies greater than or 
equal to 500 Hz. However, ALp should be reduced by 
25% at 250 Hz and by 50% at 125 Hz, according to 
reference 24. 

Because the high-speed jet noise in figures 21(d) and 
21(e) was affected by internal or shock noise as discussed 
above, corrections based entirely on equation (5) would 
be inappropriate in that case. So, for angles equal to or 
less than 90°, equation (4) was used to correct the mix of 
internal and jet noise in the forward quadrant. For larger 
directivity angles where jet noise dominates, equation (5) 
was used for the corrections. As before, the magnitude of 


the correction is indicated by the difference between the 
dashed line and the circles in figures 21(d) and 21(e). This 
procedure does not entirely resolve the uncertainty inher- 
ent in figures 21(d) and 21(e), which show comparisons of 
static (nearly pure) jet noise with forward speed 
jet/intemal noise. Because of engine temperature limita- 
tions, the static data were acquired at jet speeds low 
enough that internal noise was not evident. Thus, the 
static and forward speed noise sources are not identical 
despite the attempt to correct the static data for equivalent 
conditions. 

Discussion 

At a forward speed of 49 m/sec (fig. 21(a)), the simu- 
lated flight noise is less than the static noise at large radi- 
ation angles, as would be expected from the smaller 
relative velocity between the jet and the ambient air. At 
low radiation angles, the flight effect on jet noise 
decreases to around zero at 50°, as reported by many 
researchers. Stone (ref. 26) attributes this effect primarily 
to internally generated noise which dominates as jet noise 
decreases with forward speed. Internally generated noise 
can arise from many sources, such as combustion and tur- 
bomachinery. As forward speed increases, the peak flight 
noise near 140° decreased relative to the static case by a 
maximum of 10.5 dB at a forward speed of 130 m/sec 
(fig. 21(e)). In all cases, the flight and static data tend to 
converge as the radiation angle decreases to 40°. Amplifi- 
cation or crossover of jet noise due to flight was noted at 
small angles in figures 21(a), 21(d), and 21(e). 

Equation (5) indicates that, in flight, pure jet noise 
should decrease in the forward quadrant (low directivity 
angles) relative to the static case. On the other hand, 
internal noise should increase in the forward quadrant 
because of source motion relative to the medium 
(dynamic effect) and source motion relative to the 
observer (kinematic effect). Following Stone’s reasoning 
(ref. 26), the dynamic effect on internal noise relative to 
the the static case can be estimated by 

AL Pi = -301og[l-M o cos(y 2 )] (10) 

(Stone uses a -40 multiplication factor because he lumps 
the dynamic and kinematic effects, but the latter is not 
present in the wind tunnel). Thus, if the data in 
figures 21 (a)-2 1(e) had been generated by pure jet 
sources, the separation of the curves in the forward quad- 
rant would be greater, according to theory. Conversely, if 
both sets of data had contained strong internal noise, the 
curves would cross in the forward quadrant, which they 
do slightly in some cases. This is an example of the 
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difficulties of working with jet engines rather than 
pneumatic nozzles. Full-scale jet engines have jet and 
internal noise sources that are difficult to distinguish in 
the far field except with forward speed, when the two 
types of noises react differently. 

The attenuation of J-85 aft-quadrant noise (\|f2 > 90°) 
in flight and amplification of the forward-quadrant noise 
(Y2 < 90°) in flight simulations using the Bertin Aerotrain 
were reported by Drevet et al. (ref. 8). (The Bertin 
Aerotrain is a French air-cushion vehicle that moves along 
an inverted *‘T” track.) The J-85 was modified with an 
inlet duct lining to suppress compressor noise that might 
have affected jet noise measurements in the forward 
direction. At a flight speed of 82 m/sec and a jet speed of 
505 m/sec, there was an aft-quadrant attenuation of 8 dB 
and a forward-quadrant amplification of 1 dB. Both static 
and flight directivity patterns peaking near 140° were 
shown. For the SI data in figure 21(c), the attenuation of 
peak noise levels due to forward speed is 6 dB and the 
attenuation at 40° is less than 1 dB. These numbers go to 
7 dB and 0 dB if the wind tunnel data are corrected for 
kinematic effects present in the Aerotrain test, as will be 
explained in a later section. Hence, the two data sets are in 
reasonably good agreement with regard to peak noise 
attenuation. 

From the Aerotrain data of reference 8, Hoch (ref. 7) 
proposes that forward speed effects on jet noise can be 
explained using the concept of shear noise and self noise 
in the jet. The aft-quadrant noise is dominated by jet shear 
which becomes weaker as the relative speed between the 
jet and the ambient flow decreases. The forward-quadrant 
noise, according to Hoch, is dominated by excited turbu- 
lence or self noise in the jet interior which is less affected 
by the external flow speed. Hence, the aft-quadrant noise 
decreases with forward speed, but the forward-quadrant 
noise does not. The results of the present study cannot 
disprove Hoch’s ideas of internal jet turbulence noise with 
respect to pure jets, but the data (e.g., figs. 19(g) and 
19(i)) support Stone’s arguments about internal sources 
dominating forward-quadrant noise in flight. The forward- 
quadrant noise in figures 19(g) and 19(i) looks quite 
unlike jet or turbulence noise, as if a new source were 
developing, such as might be produced by turbomachin- 
ery, combustion, or shocks. 

The third -octave-band noise levels, wind on, are 
compared to the zero wind data in figures 22(a)-22(i), 
which illustrate 122-m-sideline data at zero and 130 m/sec 
windspeeds for third-octave bands at 125, 250, 500, and 
800 Hz and 1.25, 2.5, 5.0 and 8.0 kHz. As before, both 
curves were corrected for S 1 amplifications as listed in 
table 2, and the static data were corrected to the appropri- 


ate wind and jet speeds using equation (4) for xj/2 < 90° 
and equation (5) for ^2 ^ 90°. The static data are plotted 
with and without the wind/jet correction. The low- 
frequency data (125 and 250 Hz) show a reduction of jet 
noise due to forward speed at all angles. At other fre- 
quencies, crossover of forward-quadrant noise occurred. 
The 500- and 800-Hz data dominate the overall sound 
levels (see fig. 19(j)), which explains why the overall 
sound levels converged at small angles. 

Comparisons with Published Data 

In figures 23(a)-23(c), comparisons are shown 
between the SI Wind Tunnel results and J-85 data 
acquired in other flight tests or simulations with respect to 
overall sound levels. The curves labeled Aerotrain were 
taken from reference 6, which describes a joint General 
Electric/SNECMA test of a J-85 engine on the Bertin 
Aerotrain. The curves labeled Learjet are also from ref- 
erence 6 and represent tests of the Gates Learjet powered 
by two J-85 engines. All three sets of data in fig- 
ures 23(a)-23(c) correspond to noise on a 122-m sideline. 
In all cases, the flight and train data were corrected to 
a common forward speed and jet velocity using equa- 
tion (5) plus the following correction for kinematic effect 
of the relative motion between the source and the observer 
(this effect is not present in wind tunnel data) from 
reference 24. 

ALp k = -10 log(l - M o2 cos y 2 ) + 10 log(l - M 0 i cos y 2 ) 

( 11 ) 

The agreement among the data is fair, considering the 
differences in the experimental methods and the potential 
errors inherent in each. For example, the Aerotrain J-85 
had treated inlet ducts, and the Learjet J-85 noise direc- 
tivity was affected by wing and fuselage reflections. 
Furthermore, the accuracy of flyover noise tests are often 
poor due to variations in source position, short sampling 
times, ground reflections, and atmospheric effects. At 
angles of less than 90°, the SI Wind Tunnel data are 
consistently higher than the Aerotrain data. Since internal 
noise plays an important role in J-85 forward-quadrant 
noise, as previously discussed, the Aerotrain duct treat- 
ment may have suppressed that noise to some extent. 
From 90° to 140°, the SI and Aerotrain data agree fairly 
well. The largest differences are for angles above 140°. 
The S 1 peak levels are around 2 dB higher and at a greater 
angle by about 5° than the Aerotrain peak levels. Consid- 
ering the variety of experimental methods and corrections 
employed, the data agreement is reasonable. 
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Figure 24 is a comparison of overall sound levels of 
the J-85 engine measured in the SI Wind Tunnel with 
those measured by Atencio (ref. 1 1) in the Ames 40- by 
80-Foot Wind Tunnel before the present acoustic wall 
lining was installed (ref. 27). There were important differ- 
ences between the two studies. The Ames data were mea- 
sured 4.3 m directly below the engine, which was 
mounted below an aircraft model wing; the engine was 
6.1 m above the hard floor. The data were extrapolated to 
30.5-m flyover distance by means of an early version of 
the source-location technique. Furthermore, the Ames 
data contains corrections for wind tunnel reverberations 
and near field effects. Because the 40 by 80 test section 
was unlined, the reverberation corrections intended to 
correct the data to free field conditions are quite large, 
ranging from -9 to +12 dB. The 40 by 80 data as pub- 
lished also contain a wind correction factor so that the 
results simulate static noise propagation. This correction 
was removed for the comparison in figure 24 so that the 
SI and 40 by 80 wind effects are similar. The SI far field 
noise levels were extrapolated from 122-m sideline to 
30.5-m sideline by means of spherical radiation. The 
agreement is difficult to evaluate in detail because of the 
limited number of data points in the 40 by 80 data, and 
because of possible errors in the large corrections of the 
Ames data. It appears that the SI sound levels are about 
1-5 dB higher than the 40 by 80 levels. The 40 by 80 data 
appear to lack the peak noise. 

Comparisons with Predictions 

By plotting the difference of jet noise measured in 
simulated flight and that measured statically, Lppight - 
Lpstatic. one can compare the experimental results with 
the flight effect predictions given by equations (5) and 
(10). Flight effects on jet mixing noise (eq. (5)) account 
for two factors: (1) source strength alteration resulting 
from the external flow around the jet plume, and (2) the 
dynamic effect of the relative velocity between the jet and 
the ambient air. Because there is no relative motion 
between the airplane and the microphone in a wind tunnel, 
the kinematic effect is not present in wind tunnel data, nor 
in equation (5). Since internal engine noise is an important 
component of J-85 noise at small angles, the flight effects 
on interna] noise can also be compared with the 
experimental results. 

Predicted flight effects from equation (5) (jet noise) 
and equation (10) (internal noise) were compared to the 
data of figures 21(a)— 21(e) as shown in figures 25(a)- 
25(e). The difference between flight and static noise, mea- 
sured and predicted, are plotted. The curves all have simi- 
lar trends (slope) with respect to direction. The levels, 
however, differ. At directivity angles of less than 90°, the 


measured change in noise due to forward speed falls 
between that predicted for internal noise, which is posi- 
tive, and for jet mixing noise, which is negative. Since the 
near field data indicate that the J-85 generates a mixture 
of internal and jet noise in the forward quadrant, these 
results are reasonable. At lower jet speeds, where internal 
noise is not strongly evident, the measured results (y2 < 
150°) are within 2 dB of the prediction for pure jet noise 
(eq. (5)). At jet speeds greater than 577 m/sec, where the 
near field data indicate strong levels of internal noise (y2 
< 90°), the measured flight effects are closer to the predic- 
tions of equation (10) for internal-noise flight effects. 
Between 90° and 140°, the measured and predicted jet- 
noise flight effects (eq. (5)) agree reasonably well. This is 
also consistent with fact that jet noise dominates internal 
noise in the aft quadrant. Beyond 140° there is a discrep- 
ancy between measured and predicted flight effects. This 
is evident in figure 15, which shows that the source loca- 
tions change rapidly in the negative direction above 140°; 
that is, they appear to disappear into the engine, and are 
poorly defined. Thus, the source location method fails at 
high radiation angles. 

To summarize, the prediction of the change in pure 
jet noise due to forward speed given by equation (5) 
agrees within 2 dB of measured flight effects for jet 
speeds equal to or below 577 m/sec (excluding the faulty 
data above 140°). The data are consistently weaker (closer 
to zero) in the forward quadrant and stronger in the aft 
quadrant than predicted by equation (5). At higher jet 
speeds, the data in the forward quadrant approach, but do 
not reach, the internal noise prediction of equation (10). 
For this type of jet engine, a reasonable approach for pre- 
dicting flight effects would be to split the difference 
between equations (5) and (10) for the forward quadrant, 
and to use equation (5) for the aft quadrant 

No prediction of absolute noise levels of the J-85 is 
presented, because that would require information on the 
engine internal noise sources not available in the litera- 
ture. Attempts to use the pure jet prediction method of 
Stone et al. (ref. 24) proved unsuccessful because the 
internal sources are important on the J-85. 

Figures 26(a) and 26(b) compare the SI and Aero- 
train data (ref. 6) with the flight effect predictions at for- 
ward speeds of 41 and 82 m/sec, respectively. Three 
prediction curves are shown — one for internal noise only 
(eq. (10)), one for jet noise without kinematic effect 
(eq. (5)), and one for jet noise with kinematic effect added 
(eq. (5) plus eq. (1 1)). This last prediction is incorporated 
because the Aerotrain data should show a kinematic effect 
of relative motion between the source and the receiver, 
whereas the SI data should not. This results in a small 
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predicted amplification of pure jet noise caused by the 
motion between the aircraft and observer (the kinematic 
effect), as illustrated. Again, all curves have similar 
slopes. Unfortunately, the two data sets are not consistent 
enough to confirm the existence of the kinematic effect. 
As before, the SI data fall between the predicted internal 
and jet noise curves at most angles because of the mixture 
of jet and internal noise in the data. The S 1 and Aerotrain 
data agree within a few dB, out to 140°. Above that angle 
the SI data are in error because of the shortcoming of the 
source location/extrapolation method. Thus, the total S 1 
flight-effect results, which include source strength alter- 
ation and the dynamic effects of jet/ambient relative 
velocity, have the proper trend with regard to flight veloc- 
ity and radiation angle, according to theory and to com- 
parison with Aerotrain data, except at angles above 140°. 

CONCLUDING REMARKS 

A study of flight effects on noise from a J-85 turbojet 
engine with a conical, convergent nozzle tested in the 
ONER A SI Wind Tunnel has confirmed the strong effect 
of forward speed on noise from a full-scale engine. At the 
top simulated flight speed of 130 m/sec, the peak overall 
noise levels in the aft quadrant were attenuated approxi- 
mately 10 dB relative to noise generated statically, and the 
forward quadrant noise increased slightly at 40° 
directivity angle. 

The data indicated that internal engine and broadband 
shock noise make an important contribution to J-85 noise, 
particularly at high jet speeds, but it was unclear which of 
the two sources was dominant. The internal and shock 
noise components vary with changes in jet speed and for- 
ward speed in a different manner than does pure jet noise. 
A new empirical equation was presented that relates 
changes in internal or shock noise to changes in jet speed. 
The data were also compared with Stone’s jet noise pre- 
dictions. The comparison indicates that, in general, J-85 
flight effects can be predicted to within 2 dB using equa- 
tions for pure jets, except for the case of forward-quadrant 
noise (y < 90°) from high-speed exhausts. In that case, 
estimates of internal-noise flight effects must be incorpo- 
rated in the prediction. Kinematic amplification caused by 
aircraft motion relative to the observer (not present in 
wind tunnel data) could not be confirmed by comparing 
these results with other published data. 

The SI data were also compared with published data 
from studies of J-85 noise in an outdoor static test, a flight 
test, a wind tunnel test, and a moving train test. In general, 
the trends in the data were reasonably similar, considering 
the variety of test techniques used. Nonetheless, there 
were anomalies in the SI data. At low frequencies and 


low angles (forward quadrant), there was a 0- to 3-dB 
contamination of S 1 data as a result of sound propagation 
around the circuit. This effect was quantified by compar- 
ing SI data with free-field data to arrive at suitable 
correction factors. At directivity angles greater than 140°, 
however, the data deviated greatly from predictions and 
from other data sets because of the breakdown of the 
source-location/extrapolation technique. This breakdown 
might have been alleviated if flow noise had not 
prevented the use of sideline data measured 3.5 m from 
the jet axis. All results of this study are based on acoustic 
data acquired 2.0 m from the jet, which is a sideline 
distance that necessitated a substantial correction for near 
field propagation effects. 

One of the objectives of the program was to automate 
the Ames version of the multiple-sideline source-location 
method to create an efficient, operational data-reduction 
system for jet noise studies that would not require inter- 
mediate manipulation of the data during processing. That 
objective was not achieved. The data reduction was auto- 
mated, but the computer codes were complex and were so 
difficult to debug that the data-reduction system was not 
efficient. The only way the output could be checked was 
by comparing the final results with other published data, 
as discussed in this report. It could not be determined 
whether the anomalies in the results were due to errors in 
the computer code, or to the experimental method used, or 
to physical uncertainties related to the problem of measur- 
ing sound in the near field of distributed sources. 
Furthermore, for the near field effect, a correction factor 
had to be found during static operation of the engine and 
applied to flight data — a technique that has not been 
verified. 

These experimental difficulties could be alleviated if 
large-scale jet noise studies such as this were done in the 
recently modified 40- by 80-Foot Wind Tunnel. The large 
test section, acoustic wall treatment, long circuit, and 
acoustically treated comer vane set (refs. 28 and 29) 
would allow collection of acoustic data of sufficient qual- 
ity that it would not be necessary to push the multiple- 
sideline technique to its limits. At high speeds, back- 
ground noise in the 40 x 80 is only a few dB quieter than 
in the S 1, because the high-speed noise in both facilities is 
dominated by flow noise in the test section. However, 
acoustic antennas could reduce the effective background 
noise (ref. 23) and permit sideline traverses in the 40 x 80 
that are farther from the jet than is possible in the S 1. The 
problems encountered in the S 1 with near field effects and 
noise propagation around the circuit would be reduced in 
the 40 x 80, if not eliminated. Furthermore, the 40 x 80 
airspeed has been increased from 103 m/sec to 155 m/sec 
since the study described here was accomplished. 
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The multiple-sideline source-location method applied 
to this wind-tunnel study required substantial commit- 
ments of time and effort such as (1) static, far field noise 
surveys of the engine outside the wind tunnel, (2) acoustic 
treatment of the test section walls, and (3) development of 
a complicated data-reduction scheme. Although a larger 
test section with a good acoustic environment should 
reduce these requirements, evaluation of alternative 
methods is recommended. Hoglund, for example, pro- 
posed a simple method using cross correlation for source 
location (ref. 29). Nonetheless, the source- location 
method described here does work, within the limits dis- 
cussed above. The method used in this study resulted in a 
better understanding of the complicated roles played by 
jet and internal-engine noise sources during aircraft flight. 


Ames Research Center 

National Aeronautics and Space Administration 
Moffett Field, CA 94035-1000, June 26, 1990 
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Table 1. Jet exhaust conditions at the exit of the primary nozzle. 0 





Bm 

iisi 

Ideal c jet 
thrust, N 


545 

680 

16,137 

1.82 

11,336 

49 

522 

622 


1.78 

10,727 

72 

555 

648 

16,137 

1.91 

11,941 

88 

577 

660 

16,170 

2.0 

12,661 

113 

597 

670 

16,170 

2.10 

13,205 

130 

607 

675 


2.14 

13,208 


<*Jet conditions computed from fluid mechanic measurements of pressure and temperature. Parameters 
correspond to conditions at altitude of S 1 Wind Tunnel (1 100 m). 

^Ratio of jet total pressure to wind tunnel static pressure. 

c Momentum or ideal thrust equals net thrust plus ram drag. The maximum rated net thrust is 12,100 N. 


Table 2. Correction factors added to S 1 data to account for amplification caused by propagation around the circuit. 0 


1 

ALp, dB 


6, deg 

Overall 

125 Hz 

250 Hz 

500 Hz 

1250 Hz 

2500 Hz 

5000 Hz 

40 


-8.0 

-7.5 

-2.5 

mm 

-1.7 

-0.9 

50 

■ 

-6.0 

-7.0 

-2.0 

■Bllv: -! 

-1.7 

-0.9 

60 


-5.0 

-5.0 

-1.6 

-1.7 

-1.7 

-0.9 

70 

-2.0 

-4.5 

-3.5 

-1.5 

-1.6 

- 1.7 

-0.9 

80 

-1.7 

-4.0 

-3.0 

-1.5 

-1.6 

-1.7 

-0.9 

90 

-1.3 

-3.0 

-2.3 

-1.5 

-1.6 

-1.7 

-0.9 

100 

-1.3 

-2.0 

-1.8 

-1.0 

-1.5 

-2.0 

-0.9 

110 

-1.3 

-1.0 

-1.5 

-0.7 

-1.5 

-2.0 

-1.5 

120 

-u 

0 

-1.0 

-0.3 

-1.0 

-2.0 

-2.7 

130 

-0.5 

0 

0 

0 

-1.0 

-2.0 

-4.3 

135 

0 

0 

0 

0 

-1.0 

-2.0 

-4.2 

140 

0 

0 

0 

0 

-1.0 

-2.5 

-4.1 

145 

0 

0 

0 

0 

-1.0 

-3.0 

-4.0 

150 

0 

0 

0 

0 

-1.0 

-3.0 

-4.0 

155 

0 

0 

0 

0 

-1.0 

-3.0 

-4.0 

160 

0 

0 

0 

0 

-1.0 

-3.0 

-3.0 


°Factors are tabulated by direction and frequency. Interpolation was used for intermediate frequencies. 
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Table 3. Typical data on 2.0-m sideline with corrections and extrapolation to 122-m sideline; static case 

(induced wind = 16 m/sec). 










Corrected 

No. 

e» 

X/D 

0i;vi 

02; V2 

Near field 

Absorption 

Near field 

far field 






(2 m) Lp at 

conection 

correction 

(122 m) Lp 









at V, 

1 

40.00 

0.98 

45.66 

40.08 

115.63 

0.12 

1.70 

81.50 

2 

42.40 

1.08 

49.42 

42.50 

116.35 

0.12 

1.83 

82.35 

3 

44.80 

1.67 

57.38 

44.97 

117.48 

0.11 

1.93 

83.59 

4 

47.20 

2.10 

65.10 

47.43 

117.80 

0.11 

2.03 

84.02 

5 

49.60 

2.17 

69.49 

49.86 

117.89 

0.10 

2.11 

84.19 

6 

52.00 

2.11 

72.44 

52.27 

117.99 

0.10 

2.23 

84.41 

7 

54.40 

2.01 

74.71 

54.68 

118.11 

0.10 

2.34 

84.65 

8 

56.80 

1.89 

76.62 

57.07 

118.24 

0.09 

2.45 

84.89 

9 

59.20 

1.77 

78.35 

59.47 

118.38 

0.09 

2.56 

85.14 

10 

61.60 

1.66 

80.06 

61.87 

118.54 

0.09 

2.66 

85.40 

11 

64.00 

1.57 

81.87 

64.26 

118.73 

0.09 

2.75 

85.68 

12 

66.40 

1.49 

83.82 

66.66 

118.95 

0.09 

2.83 

85.99 

13 

68.80 

1.45 

86.07 

69.06 

119.22 

0.08 

2.87 

86.30 

14 

71.20 

1.44 

88.71 

71.47 

119.55 

0.08 

2.91 

86.67 

15 

73.60 

1.49 

91.92 

73.88 

119.95 

0.08 

2.93 

87.09 

16 

76.00 

1.64 

96.30 

76.32 

120.43 

0.08 

2.95 

87.60 

1 17 

78.40 

1.93 

102.33 

78.78 

120.96 

0.08 

2.97 

88.14 

18 

80.80 

2.18 

107.63 

81.24 

121.32 

0.08 

2.98 

88.52 

19 

83.20 

2.27 

110.78 

83.66 

121.55 

0.08 

2.99 

88.76 

20 

85.60 

2.27 

112.85 

86.07 

121.73 

0.08 

3.00 

88.95 

21 

88.00 

2.22 

114.34 

88.46 

121.89 

0.08 

3.00 

89.10 

22 

90.40 

2.14 

115.55 

90.84 

122.03 

0.08 

3.00 

89.25 

23 

92.80 

2.05 

116.60 

93.22 

122.17 

0.08 

3.00 

89.39 

24 

95.20 

1.97 

117.65 

95.60 

122.33 

0.08 

3.00 

89.54 

25 

97.60 

1.87 

118.62 

97.98 

122.49 

0.08 

2.99 

89.69 

26 

100.00 

1.79 

119.70 

100.36 

122.68 

0.08 

2.98 

89.88 

27 

102.40 

1.72 

120.90 

102.74 

122.93 

0.08 

2.97 

90.11 

28 

104.80 

1.66 

122.19 

105.12 

123.22 

0.08 

2.95 

90.38 

29 

107.20 

1.62 

123.64 

107.50 

123.60 

0.08 

2.92 

90.73 

30 

109.60 

1.59 

125.22 

109.89 

124.05 

0.08 

2.90 

91.16 

31 

112.00 

1.58 

126.94 

112.28 

124.61 

0.08 

2.86 

91.68 

32 

114.40 

1.59 

128.78 

114.67 

125.28 

0.09 

2.80 

92.30 

33 

116.80 

1.62 

130.73 

117.07 

126.07 

0.09 

2.72 

92.99 

34 

119.20 

1.66 

132.77 

119.46 

126.95 

0.09 

2.62 

93.78 

35 

121.60 

1.73 

134.88 

121.86 

127.92 

0.09 

2.52 

94.64 

36 

124.00 

1.81 

137.03 

124.26 

128.94 

0.10 

2.42 

95.56 

37 

126.40 

1.92 

139.23 

126.66 

129.98 

0.10 

2.30 

96.48 

38 

128.80 

2.05 \ 

141.43 

129.06 

130.97 

0.10 

2.19 

97.35 

39 

131.20 

2.20 

143.64 

131.46 

131.85 

0.10 

2.09 

98.13 

40 

133.60 

2.37 

145.83 

133.86 

132.57 

0.11 

2.00 

98.75 

41 

136.00 

2.56 

147.99 

136.25 

133.05 

0.11 

1.90 

99.13 

42 

138.40 

2.78 

150.09 

138.65 

133.26 

0.12 

1.79 

99.22 

43 

140.80 

3.02 

152.12 

141.05 

133.17 

0.12 

1.65 

98.98 

44 

143.20 

3.25 

154.01 

143.44 

132.78 

0.13 

1.48 

98.43 

45 

145.60 

3.45 

155.75 

145.83 

132.15 

0.14 

1.31 

97.62 

46 

148.00 

3.57 

157.26 

148.21 

131.39 

0.15 

1.12 

96.65 

47 

150.40 

3.61 

158.63 

150.58 

130.52 

0.16 

0.91 

95.56 

48 

152.80 

3.57 

159.90 

152.95 

129.56 

0.17 

0.70 

94.38 

49 

155.20 

3.45 

161.12 

155.32 

128.52 

0.19 

0.54 

93.16 

50 

157.60 

3.25 

162.34 

157.70 

127.36 

0.21 

0.37 

91.81 

1 

= 500 Hz 


Sto = 0.404 

Radial distanc 

e correction 





St = 0.416 

20*log(YY/AN) = 35.71 







(a) Engine mounted in the SI Wind Tunnel test section. 
Figure 1. J-85 engine. 
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(b) Cutaway drawing of J-85-GE-13 afterburning turbojet engine (ref. 5). 
Figure 1. Continued. 




(c) Cylindrical ejector nozzle dimensions (above) and photo (below). 
Figure 1. Concluded. 
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Figure 2. General layout of the SI Wind Tunnel. 



Figure 3. Cross section of the absorbent lining on the test section walls. 
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Figure 4. Acoustic absorption coefficients of the composite lining material (75 mm thick) plus air gap as measured in a 
standing wave tube. 


SIDE VIEW 


END VIEW LOOKING 
DOWNSTREAM 


8-m-DIAMETER 



(a) Assembly schematic. 


Figure 5. Model and microphone systems in the SI test section. 
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(b) Assembly photograph (traverse support strut fairings not installed yet). 
Figure 5. Continued. 
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48 MICROPHONES SPACED 
150 mm APART 




TOP VIEW 


Dimensions in mm 


VIEW A-A 


(c) Schematic of fixed microphone antenna array. 


Figures. Concluded. 
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FAR SIDELINE 




Figure 6. Source location geometry (static case). Figure 7. A comparison of J-85 noise on 2.0-m sideline 

measured in SI Wind Tunnel and at NASA Ames outdoor 
test site (static case); overall sound levels. 



100 160 250 400 630 Ik 1.6k 2.5k 4k 6.3k 10k 16k 
1/3 OCTAVE BAND FREQUENCY. Hz 


Figure 8. An example of 2.0-m sideline raw data and curve fit (static case); 0j = 1 19°. 
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Lp,dB 



(a) f = 500-Hz third-octave band. 0>) 8-kHz third-octave band. 

Figure 9. Typical angle pairs with the same noise difference as that for the peak levels (ref. 2). 



Figure 10. Angle of peak radiation versus Strouhal number Sto (static case) measured at SI and at Ames (ref. 2). 
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(a) f= 125 Hz. 


(b) f = 500 Hz. 


Figure 1 1 . Typical source locations versus radiation angle for the static case (ref. 2); Vj = 5 14 m/sec. 



(a) f = 500 Hz. (b) f= 2500 Hz. 

Figure 12. A comparison of source locations measured statically (ref. 2) at Ames and in the S 1 Wind Tunnel. 





(")<Vj/c> 


Figure 13. Near field corrections (ref. 2). 


STATIC RADIATION 

RADIATION IN WIND 



Figure 14. Nomenclature for source location and radiation with and without wind 




X'/d X'/d 



(a) f = 125 and 250 Hz. (b) f = 500 and 1 kHz. 

Figure 15. Typical source locations versus radiation angle as transformed from static data using equations 1 and 2- 
V a = 88 m/sec, Vj = 577 m/sec. 
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(b) Extrapolation to 122 m 
Figure 16. Concluded. 




CALCULATOR C1110020 


TRANSMITTED BY 
NASA AMES 



Figure 17. Schematic of data reduction procedures (ref. 23). 
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Figure 20. Variation of near field internal or shock noise (upper curve) and far field jet/intemal noise (lower curve) 
versus jet speed from figs. 19(c)-19(j) at two frequencies where internal noise is strong. The data are peak levc s 

between 60° and 90° radiation angles. 




(a) V a = 0 and 49 m/sec. (b) V a - 0 and 72 m/sec. 

Figure 21 Comparisons of J-85 static and S 1 simulated-flight overall sound levels at 122-m sideline. All data corrected 
for SI amplification listed in table 1. The nominally static data (dashed cuiwe) were corrected to zero w.ndspeed and the 
proper jet speed (circles). 
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, dB L n , dB 



1^2# deg ^ 2 ' 

(c) f = 500 Hz. (d) f = 800 Hz. 

Figure 22. Comparisons of J-85 static and SI simulated flight noise in third-octave bands at 122-m sideline; V a = 0 and 
130 m/sec. All data corrected for SI amplification listed in table 1. The nominally static data (dashed curve) were 
corrected to zero windspeed and the proper jet speed (circles). 
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(a) V a = 0, Vj = 545 m/sec. (b) V a = 43 m/sec, Vj = 558 m/sec. 



Figure 23. Comparisons of SI Wind Tunnel, flyover, and moving train overall sound levels of J-85 at 122-m sideline. SI 
data corrected for wind tunnel amplification (table 1). Aerotrain and Lear Jet data corrected to S 1 windspeed and J-85 jet 
speed using equation (5). 
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125 r 



Figure 24. J-85 overall sound levels as measured in the SI Wind Tunnel and the Ames 40- by 80-Ft Wind Tunnel (V a = 
52 m/sec; Vj = 582 m/sec). The SI data were corrected to the 40 by 80 wind and jet speed, and then extrapolated from 
122 m to 30.5 m. The 40 by 80 data (ref. 10) were corrected for near field effects and wind tunnel reverberations, and 
extrapolated from 4.3 m to 30.5 m. 



(a) V a = 49 m/sec, Vj = 522 m/sec. 


(b) V a = 72 m/sec, Vj = 555 m/sec. 


Figure 25. A comparison of measured and predicted flight effects in SI Wind Tunnel. The difference between measured 
flight and static noise of figures 21(a)-21(e) is compared with predicted flight effects for pure jet noise (eq. 5) and 
internal engine noise (eq. 10). 
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(c) V a = 88 m/sec, Vj = 577 m/sec. (d) V a = 1 1 3 m/sec, V 

JET NOISE (Eq. 5) 



; = 597 m/sec. 


(e) V a = 130 m/sec, Vj = 607 m/sec. 
Figure 25. Concluded. 




□ SI DATA 

• Eq. 5 AND Eq. 1 1 - JET NOISE WITH KINEMATIC 
■ AEROTRAIN DATA 



□ SI DATA 

• Eq. 5 AND Eq. 1 1 - JET NOISE WITH KINEMATIC 



(b) V a = 82 m/sec. 

Figure 26. SI and Aerotrain flight effects (difference between forward speed and static J-85 noise) compared with pre- 
dictions for pure jet and internal noise sources. The pure jet noise predictions were made with and without kinemauc 

effects. Vj = 546 m/sec. 
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APPENDIX A 
NOISE 3 


•m j tj jm 


PRECEDING PAGE BLANK NOT FILMED 


* 

CPROGRAMME SOURCE N03BD 
C 

c - - - 

c 

C MAIN PROGRAM FOR FIRST PHASE OF ANALYSIS 

C 

C LOGICAL UNIT ASSIGNMENTS -- 

C 

C UNIT FILE 

C 05 INPUT FILE FOR ENGINEER SUPPLIED PARAMETERS ( I UN ) 

C 06 OUTPUT FILE (PRINT OUTPUT) 

C 07 BINARY OUTPUT FILE 

C 08 CORRECTION FILE INPUTS 

C 10 SPL DATA FILE(LUN) 

C 

C - - - 

C 

c# * # * # 

REAL* 8 DECB , ANGLES , XD I S , HTM IKE, HTSRCE , SDHUM, SDTEMP , V8 , UN I TS , 

1 THETAM, ADEL, BDEL, AN, YF, YY, ANHI , ANLO, AFHI , AFLO, 

2 COFA, COFB, TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, VJET, 

3 FREQ , THETAS , XOVERD , XDMAX , THETSM , RNZD I A 
C****x 

REAL *8 ABDBM, DISTME, FTOM, PRESS, RTOK, TEMPK 
REAL* 8 STR, DFMAX, XPEAKN, XPEAKF, DUMP1 (132) 

C*xxxx 

REAL*8 JETN( 130, 33) , DUMP(3446) 

COMMON /SUB/ MIKES, MIKEA, MIKEB, I CALL, DECB ( 1 30, 35), 

1 ANGLES ( 1 30) , XDISC 130, 2) , HTMI KE( 130) , HTSRCE, SDHUM, 

2 SDTEMP, V8, UNI TS,KFIT(2), IWTB, IWTE, 

3 THETAMC 33) , ADEL, BDEL, AN, I GRC, NRUN, 

4 YF, YY, ANHI , ANLO, AFHI , AFLO, COFA( 16, 35) , COFB( 16,35), 

5 TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, 

6 I B I DO, IMRC, I BNC, IRC, IAAC, I DATE, 

7 VJET, FREQ ( 33 ) , THETAS ( 50, 33 ) , XOVERD ( 50, 33 ) , NTAB ( 33 ) , 

8 NTEST, XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A, NZTYPEt 10), NFREQ 
C 

COMMON /OUTFLG/ I PFRQC, I PANGL, I PFNDM, I PROOT, I PFNDY 
C 

c* * * * * 

COMMON /TRAFLG/KTRAC, KTDECB, KTDI FF, KTXSD, KTPEAK 

C** * # * 

COMMON /TABD/STR ( 33 ) , DFMAX ( 33 ) , XPEAKN ( 33 ) , XPEAKF ( 33 ) 

C* * * * * 

COMMON / I DENT/NPO I , KM I C , NPO I 2 

COMMON /T I TRE/L I B( 1 0) , I DAT ( 3) j DB1 (8,4), IPI(6) 

C# * * # * 

DIMENSION I T I T ( 20 ) , XMOD ( 44 ) , L I B 1 ( 20) , LIB2( 20) 

C 

EQUIVALENCE ( DUMPC 1 ) , VJET ) 

EQUIVALENCE ( DUMP1 ( 1 ) , STR ( 1 ) ) 

DATA PRESS, RTOK, FTOM, D2R /1.0, 0.5555556, 0.3048, 0.017453293/ 

C 

C KODT 0 TRA I TEMENT BANDE MODANE 

C KODT 1 TRA I TEMENT DONNEES AMES SUR CARTES 

C KODT 2 TRA I TEMENT DONNEES AMES SUR BANDES 

READ ( 5, 101 )KODT 
101 FORMAT (15) 

C** * * * MISE A ZERO DU TABLEAU DECB 
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DO 10 J=1 , 130 
DO 10 1=1,35 
DECB( J, I )=0. 

10 CONTINUE 
c* * ** * 

R2D = 1.0/D2R 

C LECTURE BANDE ECRITURE DISQUE 

ND = 2 

CALL READ I N (KODT, KL I SF, ITI T , L I B1 , L I B2 ) 

C#**** PREPARATION DU TRACE 

IF(KTRAC.EQ.O) GO TO 150 
DO 160 1=1,44 
XMOD ( I ) =0 . 

160 CONTINUE 
KPLANC=0 

CALL 0PENTR(69, XMOD ) 

150 CONTINUE 

°*****CALL OSPL (DECB, MIKES, NFREQ) 

CALL SUBPDB ( M I KES, DECB, NFREQ ) 

1001 FORMAT (?H1?30X,55HS0UND PRESSURE LEVELS READ AS INPUTS FOR THIS EX 

* CALL 1 OUTPUT ( XD I S , DECB , ANGLES , FREQ , M I KES , NFREQ , HTM I KE 1 
C 

IF ( I MRC . NE. 1 ) GO TO 40 

I CALL = 1 
CALL CORECT 
40 CONTINUE 

IF C I BNC .NE. 1 ) GO TO 50 

I CALL = 2 
CALL CORECT 
50 CONTINUE 

IF ( IRC .NE. 1 ) GO TO 60 

I CALL = 3 
CALL CORECT 
60 CONTINUE 

IF ( 1AAC.NE. 1 ) GO TO 80 

APPLY ATMOSPHERIC ABSORBTION CORRECTION TO EACH SPL. USE SUBRT . A I FAB. 
PRESS = ATMMOSPHERES 
RTOK = DEG R TO DEG K CONVERSION 
FTOM = FEET TO METERS CONVERSION 


TEMPK = TTEMP * RTOK 
DO 200 NF = 1 , NFREQ 

CALL A I FAB ( PRESS, TEMPK, SDHUM, FREQ ( NF) , ABDBM ) 
DO 220 NM = 1 , MIKES 

DISTME = XD I S ( NM, 2) * FTOM 
DECBCNM, NF) = DECBCNM, NF) + ABDBM* D I STME 
220 CONTINUE 
200 CONTINUE 

APPLY JET NOISE GROUND REFLECTION CORRECTIONS 


80 IF (IGRC.EQ.O.) GOTO 70 
DO 77 NM = 1 , MI KES 
DO 77 NF = 1 , NFREQ 
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77 JETN ( NM, NF ) = 0.0 

CALL GRNO IS ( XD I S ( 1 , 2 ) , HTM I KE , JETN , HTSRCE , TTEMPF , M I KE3 . FREQ, NFREQ ) 
WRITEC6.71) 

71 FORMAT ( 1 HI , 1 OX, 35HGR0UND NOISE REFLECTION CORRECTIONS /) 

CALL OUTCOR ( JETN, M I KEA , M I KEB , NFREQ ) 

DO 75 NM = 1 .MIKES 
DO 75 NF = 1 . NFREQ 

DECB ( NM, NF ) = DECB ( NM. NF ) - JETN( NM, NF ) 

75 CONTINUE 
70 CONTINUE 
C 

I F ( I MRC . EQ . 0 . AND . I BNC . EQ . 0 . AND . I RC . EQ . 0 . AND . I AAC . EQ . 0 ) GOTO 90 
CALL OSPL ( DECB. MIKES. NFREQ ) 

CALL SUBPDB (MIKES. DECB. NFREQ ) 

C 

C 

WRITE (6. 1002) 

1002 FORMAT ( 1 HI . 30X. 22HDATA AFTER CORRECTIONS /) 

CALL OUTPUT (XDIS. DECB. ANGLES. FREQ. MIKES. NFREQ, HTM IKE) 

C 

90 CONTINUE 
C 

C***x* SAUVEGARDE DE DECB AVANT L I SSAGE 
IFCKTDIFF. EQ. 0) GO TO 130 
CALL SAVDECB ( DECB ) 

130 CONTINUE 
C* * * * * 

c»***« TRACE DES MESURES 

1 F ( KTDECB . EQ . 0 ) GO TO 170 
NCAR= 1 7 

CALL TDECBCKPLANC, DECB. ANGLES. FREQ. NFREQ. MI KEA. MI KEB. 

1 'FIG. MESURES. ' .NCAR.XMOD) 

170 CONTINUE 

CALL KURVFTCKLISF) 

TRACE DES POLYNOMES D INTERPOLATION 
I F (KTDECB. EQ.O) GO TO 180 
NCAR=35 

CALL TDECBCKPLANC. DECB. ANGLES. FREQ. NFREQ. MI KEA. MI KEB. 

1 ‘FIG. POLYNOMES D INTERPOLATION. ' . NCAR , XMOD ) 

180 CONTINUE 

C***«* TRACE DES DIFFERENCES 

IFCKTDIFF. EQ.O) GO TO 140 
NCAR=80 

CALL TDI FF (KPLANC. DECB. ANGLES. FREQ, NFREQ, Ml KEA. Ml KEB, 

1 I TIT, NCAR, XMOD) 

140 CONTINUE 
c* # * # # 

WRITE (6, 1003) 

1003 FORMAT ( 1 HI , 30X, 24HDATA AFTER CURVE FITTING /) 

CALL OUTPUT ( XD I S, DECB, ANGLES, FREQ, Ml KES, NFREQ, HTM I KE ) 


110 CALL DIRECT 

CALL STAB ( NFREQ , FREQ , THETSM , XDMAX ) 

C* * * * * TRACE X/D = F( THETA -S) 

IFCKTXSD. EQ. 0) GO TO 230 

CALL TXSDCKPLANC, XOVERD, THETAS, NTAB, NFREQ, XDMAX, THETSM, 
1RNZDI A, VJET, FREQ, LI B1 , LIB2, XMOD) 

230 CONTINUE 
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C* * * * * TRACE DE THETA-S DU PI C = F(STROUHAL) 

I F ( KTPEAK . EQ . 0 ) 00 TO 240 

CALL TPEAK C KPLANC , TIHETSM, STR , NFREQ, RNZDI A, VJET, LIB1 , LIB2 
1 j XMOD ) 

240 CONTINUE 

c 

c 

c 

C DUMP COMMON TO DISK FILE AND SAVE THE CORRECTED 

C DATA FOR PHASE 2 ANALYSIS . . . 

C FILE IS WRITTEN IN UNFORMATTED BINARY 

C 

120 CONTINUE 

C ECRITURE SUR BANDE 

WR I TE ( 7 ) DUMP 
WRl TEC71DUMP1 
WRI TE ( 7 ) NPO I 
WRl TEC 7) LIB 
WRITEC7) IDAT 
WRl TE(7) LIB1 
WRl TEC 7) LIB2 
REWIND 7 
C 

FIN DE TRACE 
I FCKTRAC. EQ. 0) STOP 
CALL CLOSTR ( XMOD ) 

WRI TEC 6 , 1 004 ) KPLANC 

1004 FORMAT ( 1 HI ///3Xj ' NOMBRE DE PLANCHES= 1 , 13////) 

STOP 

END 

*DECK READ IN 

SUBROUTINE READ I NCKODT, KLISF, I Ti T, LIB1 , LIB2) 

C 

C 

C SUBROUTINE READ IN IS RESPONSIBLE FOR READING AND STORING INTO 

C COMMON THE DATA AND PARAMETERS JO BE USED FOR PROCESSING. 

C AS THE DATA IS READ IT IS ALSO PRINTED TO THE LINE PRINTER 

C RESULTS FILE (UNIT 06). 

C 

C ENGINEERS INPUTS AND PARAMETERS ARE READ FROM LOGICAL UNIT 

C ASSIGNED TO VARIABLE LUN, USUALLY 5. 

C 

C ANGLES AND DECIBEL READINGS FOR EACH MIKE ARE READ FROM 

C LOGICAL UNIT NUMBER I UN WHICH MAY OR MAY NOT BE THE SAME 

C AS LUN DEPENDING ON THE CONF I GUARAT I ON CHOSEN BY THE PROGRAMMER. 

C 

C 

c 


c*** * * 

REAL*8 

1 

2 

3 

C* # # * * 

REALMS 

COMMON 


DECB, ANGLES, XDI S, HTMIKE, HTSRCE, SDHUM, SDTEMP, V8, UNITS, 
THETAM, ADEL , BDEL , AN, YF , YY , ANH I , ANLO , AFH I , AFLO , 

COFA, COFB , TR , R2D , D2R , SDTEMF , TTEMP, TTEMPF , VJET , 

FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDI A 

RFACT, THUM, RNZDI N, HTMI K, ALPHA, H, D 

/SUB/ M I KES , M I KEA , M I KEB , I CALL , DECB ( 1 30 , 35 ) , 



1 ANGLES ( 1 30) , XDIS< 1 30, 2) , HTMIKEI 130) , HTSRCE, SDHUM, 

2 SDTEMP, V8, UNI TS, KF I T( 2) , IWTB, IWTE, 

3 THETAMf 33) , ADEL, BDEL, AN, IGRC,NRUN, 

4 YF, YY, ANHI , ANLO, AFHI , AFLO, COFA( 1 6, 35) , COFB( 1 6, 39) , 

5 TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, 

6 1BID0, I MRC, I BNC, IRC, IAAC, IDATE, 

7 V JET , FREQ ( 33 ) , THETAS ( 50, 33 ) , XOVERD (50,33), NTAB ( 33 ) , 

8 NTEST , XDMAX { 33 ) , THETSM ( 33 ) . RNZO I A , NZTYPE (10), NFREQ 
C 

COMMON /OUTFLG/ I PFRQC, I PANGL, I PFNDM, I PROOT, I PFNDY 
C 

COMMON /TRAFLG/KTRAC.KTDECBjKTDIFF.KTXSD.KTPEAK 
COMMON / I DENT/NPOI t KM I O t NPOI 2 
DIMENSION ITIT(1) J LIB1(1) i L!B2(1) 

C***<t* 


C 


c 


C 


C 


DATA IUN.LUN /B.S/ 
DATA RFACT /4S9.6/ 


WRITEtS.eOO) 

READ ( I UN, 910) NPO I , KM I C , NPO I 2 
910 FORMAT( 13, IX, I 1 , 15) 

READ (I UN, 901) NTEST, NRUN, NZTYPE 

WRITE (6,801) NZTYPE, NTEST, NRUN, NPO I, KM I C, NPO I 2 


READ ( I UN , 902 ) I PFRQC , I PANGL , I PFNDM , I PROOT , I PFNDY 
WRITE (6,802) I PFRQC , I PANGL , I PFNDM , I PROOT , I PFNDY 


READ (I UN, 902) I MRC, I BNC, I RC, I AAC, I GRC, KL I SF 
WRITE (6,807) I MRC, I BNC, I RC, I AAC, I GRC, KL I SF 


C»***x LECTURE DES FLAGS DE TRACE 

READ( I UN, 902) KTRAC, KTDECB, KTDI FF, KTXSD, KTPEAK 
READ ( I UN, 1910)(ITIT(I), 1 = 1,20) 

READ( I UN, 1910) (LIB1 ( 1 ), 1 = 1,20) 

READ( I UN, 1910) (LIB2( I ), I =1 ,20) 

WR I TE ( 6 , 8 1 0 ) KTRAC , KTDECB , KTD I FF , KTXSD , KTPEAK 

C*««xx 


READ ( I UN, 903) MI KEA, MI KEB, MI KES, KFI T( 1 ) , KFI T(2) » I WTB, I WTE 
C 

READ (I UN, 904) AN, YF, YY , ANHI , ANLO, AFHI , AFLO, ADEL, BDEL 
AN=AN*3. 2808 
YF=YF*3, 2808 
YY=YY*3. 2808 

WRITE (6,804) AN, YF, YY, ANLO, AFLO, ANHI , AFHI , ADEL, BDEL 
C 

READ (I UN, 902) I TMPTP 
C 

IF ( I TMPTP . NE . 0 . AND . I TMPTP . NE . 1 ) STOP 3 
IF ( I TMPTP. NE. 1 ) GOTO 200 

READ (I UN, 905) V8, THUM, TTEMPF, SDHUM, SDTEMF, RNZD I N 
TTEMP = TTEMPF+RFACT 
SDTEMP = SDTEMF+RFACT 
GOTO 210 

200 READ (I UN, 905) V8, THUM, TTEMP, SDHUM, SDTEMP, RNZDI N 
TTEMPF = TTEMP-RFACT 
SDTEMF = SDTEMP -RFACT 

C RNZDI N IS IN METRES, SWITCH TO RNZDIA IN FEET FOR 

C CALCULATIONS TO BE DONE IN SUBROUTINE DIRECT 

210 RNZDIA = RNZDI N*3. 2808 
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WRITE (6,806) V8, THUM, SDHUM , RNZD I N , RNZD I A, TTEMPF, TTEMP , 
SDTEMF, SDTEMP 


THESE VARIABLES ARE SET EQUAL DUE TO NUMEROUS PROORAM CHANGES. 


V JET = V8 

READ (IUN.908) HTSRCE, HTMI K 


I F ( KODT . NE . 0 ) GO TO 100 
LECTURE 2 LI ONES DE MICROS 

RECHERCHE DES ANGLES DE LA LIGNE 2 EN TOTAL I TE 

RECHERCHE DES ANGLES DE LA LIGNE 1 EGAUX A CEUX DE LA LIGNE 2 
CALL RECHPO I N ( NFREQ , M I KES , M I KEA , M I KEB , DECB , FREQ , ANGLES ) 

GO TO 300 

100 I F ( KODT ! EQ ! 2 ) CALL RECHNASA ( NFREQ , M I KES , M I KEA , M I KEB , DECB , FREQ , ANGLE 

300 WRITE (6,803) M I KEA, M I KEB, M I KES , KF I T ( 1 ) , KFI T ( 2) , I WTB, I WTE 
IF (MIKES. NE. (MIKEA+MIKEB) ) STOP 1 
DO 101 J=1, MIKES 

101 HTMI KE ( J ) =HTMI K „ ll/rel 

WRITE (6,809) HTSRCE, ( HTM I KE ( I ) , I = 1 , MI KES) 

809 FORMAT ( / 1X,20HSOURCE HEIGHT (FT) =, F6.2 / 

* IX, 20HMI CROPHONE HEIGHT =, 1 5F6 , 2 / 2 ( 21 X, 1 5F6 . 2/ ) 21X,5F6.2) 


CALCULATION OF MIKE DISTANCES BASED ON 
MIKE HEIGHT AND ANGLE . . . SEE PROGRAM 
FOR REFERENCE ON METHOD USED (GEOMETRY) 


DOCUMENTATION 


DO 110 L= 1 , MIKES 

IF ( L . GT . MI KEA) GOTO 111 

IF (HTSRCE. EQ. HTMI KE(L) ) GOTO 112 

XDI S( L, 2) = AN/DS I N( (180. -ANGLES ( L ) ) *D2R ) 

XD I S ( L , 1 ) = XDI S( L, 2) *DCOS( (180. -ANGLES(L) ) *D2R) 

GOTO 1 1 0 

112 IF (ANGLES(L) . GT . 90. ) ALPHA=90 . -ANGLES ( L) 

IF ( ANGLES ( L ) . LT . 90 . ) ALPHA= ANGLES ( L) -90 . 

H = HTSRCE -HTM I KE ( L ) 

IF ( ANGLES(L) . EQ. 90. ) GOTO 113 
D = AN/DCOS ( ALPHA*D2R ) 

XD 1 S ( L, 1 ) = DSQRT ( AN*AN+D*D) 

XD I S ( L , 2 ) = DSQRT (D*D+H*H) 

GOTO 1 1 0 

1 13 XDI S( L, 1 ) = 0.0 

XDI S( L, 2) = DSQRT( AN**2+H**2) 

GOTO 110 

111 IF (HTSRCE. EQ. HTMIKE(L) ) GOTO 114 

XD I S ( L, 2 ) = YF/DSIN( ( 180. -ANGLES(L) )*D2R) 

XD I S ( L, 1 ) = XDI S( L, 2 ) *DCOS( (180. -ANGLES ( L) ) *D2R) 
GOTO 1 1 0 

114 IF (ANGLES(L) . GT. 90. ) ALPHA=90 . -ANGLES ( L ) 

IF (ANGLES(L) . LT. 90. ) ALPHA= ANGLES ( L ) -90 . 

H = HTSRCE-HTMIKE(L) 

IF ( ANGLES ( L ) . EQ . 90 . ) GOTO 115 
D = YF/DCOS( ALPHA *D2R) 

XD I S ( L, 1 ) = DSQRT (YF**2+D**2) 

XD I S ( L, 2 ) = DSQRT (D*D+H*H) 
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GOTO 1 1 0 

115 XDIS(L, 1 ) =0.0 

XD I S ( L, 2 ) = DSQRT (YF**2+H*#2) 

1 10 CONTINUE 

WRITE (6,805) ( XD I S ( L , 1 ) , L= 1 , M I KES ) 

WRITE (6,808) ( XDI S ( L, 2) , L= 1 , MI KES) 

C 

INPUT FORMATS 
C 

901 FORMAT (13, 12, 10A4) 

902 FORMAT (611) 

903 FORMAT (712) 

904 FORMAT (10F6.2) 

905 FORMAT ( 5F1 0 . 1 , FI 0 . 2 ) 

90S FORMAT (16F5.0) 

909 FORMAT (16F5.2) 

1910 FORMAT (20A4) 

*****OUTPUT FORMATS 

800 FORMAT ( 1 HI , 37HS0URCE LOCATION PROGRAM - STATIC CASE // IX 

* 40H INPUT PARAMETERS READ FOR THIS EXECUTION /) 

801 FORMAT (IX, 1 6HI DENT I F I CAT I ON =,1X, 1 0A4 , 5X, 4HTEST, I 4 , 5H RUN , 

* I3.30X, 14, 4H M ,11,15) 

802 FORMAT ( IX, 1 6H0UTPUT FLAGS =,1X,6I1) 

803 FORMAT ( / 1 X, 1 9HNEAR FIELD MIKES = ,I2,10X, 

* 1 8HFAR FIELD MIKES = , I 2, 1 OX, 1 4HT0TAL MIKES = ,13 / 

*1X, 10HKFIT(1 ) = , 12, 19X, 10HKFIT(2) = ,12, /IX, 

* 1 OH I WTB = , 12, 19X, 10H1WTE = ,12) 

804 FORMAT!// 12X,10HNEAR FIELD, 6X, 9HFAR FIELD / 

* 1 X, 8HDI STANCE, FI 1 . 3, 5X, FI 1 .3, 5X, FI 1 . 3 / 1X,3HL0W, 

*F1 6 . 3, 5X, F 1 1 . 3 / IX, 2HH I , FI 7 . 3, 5X, FI 1 . 3, 5X, 5HDELTA, FI 4 . 3, 5X, FI 1.3) 

806 FORMAT ( / 1X,8HV(INF) = , F8 . 2 / 

* IX, 8HTHUM = , F8 .2,1 OX, 7HSDHUM = , F8 . 2, 1 0X, 1 2HN0ZZL.E DIA =, 

*F8 . 4 , 9H METRES =,F8.4,5H FEET, 

* // 21 X, 5HDEG F, 1 OX, 5HDEG R / 1 X, 1 1 HTUNNEL TEMP, 7X, 

*F7. 1 ,8X,F7. 1 / IX, 1 2HSTD DAY TEMP, 6X, F7 . 1 , 8X, F7 . 1 ) 

805 FORMAT!// IX, 14HMIKE DISTANCES / 

* 1 X, 1 3HCENTER LINE =,10F10.3,/ 3 ( 1 4X, 1 0F1 0 . 3 /)) 

807 FORMAT ( 1 X, 1 9HC0RRECT I ON FLAGS =,1X,6I1) 

808 FORMAT ( / 1X,13HS0URCE DIST =,10F10.3 / 3( 14X, 1 0F1 0 . 3 /)) 

810 FORMAT ( IX, 'PLOT FLAGS =',5I1) 

END 

*DECK OSPL 

SUBROUTINE OSPL ( DECB, M I KES, NFREQ) 

C# * # * * 

REAL*8 DECB ( 1 30, 35 ) 

REAL*8 D , DDB , S 

C* * ##* 

DO 400 11=1 .MIKES 
S = DECB( 11,1) 

DO 390 L=2, NFREQ 
D = DECB( I I , L) 

IF (D.LT.40.) GO TO 390 
DDB=DABS(S-D) 

IF (DDB.GT.7.5) GO TO 380 

S=DEXP( 1.1115) *DEXP( - . 1 9077*DDB ) +DMAX1 (S, D) 

GO TO 390 

380 S = DEXP ( 1 . 1406) *DEXP( - . 201 72*DDB ) +DMAX1 (S, D) 

390 CONTINUE 
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DECB (II, 34 ) = S 
400 CONTINUE 
RETURN 
END 

•DECK PNDP 

SUBROUT I NE PNDB (LP, NF, PLDB, DL, ALO , ANN, ANO ) 

THIS SUBROUTINE HAS BEEN MODIFIED TO WORK ONLY FOR ONE -THIRD 
OCTAVE BAND WIDTH. 


C*»*** 

REAL*8 SUMN, PLDB 

Cm * * * * 

REAL* 8 DL (24,2), ALO (24,2), ANN (24,2), ANO ( 24 , 2 ) 

REAL*8 LP ( 27 ) , LB ( 24 ) , NOY ( 24 ) , NMAX , NBAR 
N = NF 

I F ( N . GT . 24 ) N=24 
DO 21 1=1,24 

21 LB< I ) =LP( I ) 

NMAX=0 . 0 
SUMN=0.0 
DO 13 I = 1 , N 

NOY ( I ) =DM I N1 ( ANO ( I , 1 )*ANN( I , 1 )**( (LB( I )-ALO( 1,1) )/DL( 1,1)), 
1 ANO ( I , 2) *ANN( I , 2 ) * * ( ( LB ( I ) -ALO( 1,2) )/DL( 1,2))) 

I F ( NOY ( I ) . 0E. NMAX ) NMAX = NOY C I ) 

13 SUMN=SUMN+NOY( I ) 

NBAR = NMAX+O, 1 5* ( SUMN- NMAX ) 

PLDB=40. 0+1 0 . 0*DL0G1 0( NBAR) /DL0Q1 0(2. O) 

I F( PLDB . LT . 0 . 0 ) PLDB=0 . 0 

RETURN 

END 

•DECK SUBPDB 

SUBROUTINE SUBPDB (M I KES, DEC I BL, NFREQ) 

REAL*8 PDB 

REAL*8 DECIBLC 130, 35) , LP(27) 

REAL*8 DL (24,2), ALO ( 24 , 2 ) , ANN( 24 , 2) , ANO( 24, 2) 

DATA DL/ 15*10. , 9* 1 1 0 . , 30 . , 25 . ,2*26. 

1 ,28. , 2*27. , 30. , 51 . , 6*10. , 7*1 10. , 6. ,9. / 

DATA ALO/52. , 51 . , 49 . , 47 . , 46 . , 45 . , 43 . , 42 . , 41 . ,5*40. , 38 . , 34 . 


1 , 32. , 30. , 2*29. , 30. 

2 ,46. ,44. ,42. ,5*40. 
DATA ANN/1 5*2. ,9*1975. , 13. 

1 136.7,6*2. ,7*1975. 

DATA ANO/48* 1 . 0/ 


,31 . ,34. ,37. ,64. ,60., 56. ,53. ,51 . ,48. 

, 38. , 34. , 32. ,30. ,2*29. , 30 . , 31 . , 37 . , 4 1 
5,10.3, 2*9.07,9.76, 2*7.94,9, 15, 

, 1 .79,2.4/ 


C 

L24 = 24 

IF ( NFREQ .LT. 24 ) L24 = NFREQ 
DO 280 I I = 1 , Ml KES 
KSW = 0 

DO 260 L= 1 , L24 

LP ( L ) = DEC I BL( I I , L + 6 ) 

IF ( LP ( L ) . 0T . 0 . 0 ) KSW = 1 
IF (LP(L) . LT. 0. 0) LP ( L ) = 0.0 
260 CONTINUE 

IF (KSW.0T.O) GO TO 270 
PDB=0 . 

GO TO 280 
270 CONTINUE 
NF = L24 

CALL PNDB ( LP , NF , PDB , DL , ALO , ANN , ANO ) 
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c 

IF ( DABSC YM1 ) .LT. EPS ) GO TO 190 
C 

KNTBI = 0 
C 

XI = XM1 
X2 = XM2 
C 

C**************#******#**####*####**#*******#*****# 


USE FOR DEBUGGING . 

I F ( IPRINT.EQ. 1 ) WRITE(6 J 97) X 1 , X2, YM1 , YM2 
97 FORMAT (2X,26HSTART WITH X 1 , X2 , YM1 , YM2 , 4E16.8 ) 

g************************************************ 


99 CONTINUE 

KNTBI = KNTBI + 1 

IF ( KNTBI .GE.ITER ) GO TO 1500 

DIVIDE THE INTERVAL , (X1,X2) AND CHECK BOTH HALVES FOR THE ROOT. 

THE TWO HALVES ARE (XI, XBAR) , (XBAR,X2) 

XBAR = ( XI + X2 ) / 2. 

IF ( DABS ( X2-X1 ) . LE . EPS ) GO TO 150 

120 CONTINUE 

Y 1 = POLYX ( COEF , N, X 1 ) 

YBAR = POLYX ( COEF,N,XBAR ) 

CHECK FOR THE ROOT IN THE 1ST HALF . 

CHECK = Y 1 *YBAR 

IF C CHECK .LE. 0 . 0 ) X2 = XBAR 
IF ( CHECK .LE. 0.0 ) GO TO 99 


CHECK FOR THE ROOT IN THE 2ND HALF . 

XI = XBAR 
GO TO 99 

150 CONTINUE 

YY = POLYX ( COEF, N, XBAR ) 

IF ( DABS ( YY ) .GT. EPS ) GO TO 120 
KNTR = KNTR + 1 
ROOTS (KNTR) = XBAR 
YROOTS (KNTR ) = YY 
XM2 = XBAR 
YM2 =0.0 

IF( IPRINT.EQ. 1 )WRITE(6, 170) KNTR, KNTBI 
170 FORMAT ( IX, 9HR00T NUM . , I3,5H USED , I3,11H ITERATIONS ) 


GO TO 190 
1500 CONTINUE 
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I ERR = 1 

IF C I PR I NT .NE. 1 ) GO TO 190 

WRITE ( 6, 1600) ITER, EPS 

1600 FORMAT (IX, I2.45H ITERATIONS FAILED TO GIVE DESIRED ACCURACY ( , 

2E14.7.2H ) / ) 

WRITE(6, 1700) XI, X2 

1700 FORMAT ( IX, 7HX1.X2 = , 2E10.9 / ) 

190 CONTINUE 
XM1 = XM2 
YM1 = YM2 


200 CONTINUE 
250 CONTINUE 

IF ( KNTR . LT . 1 ) GO TO 600 

GO TO 900 

300 CONTINUE 


IF N=2 , WE HAVE THE 2ND DEGREE EQ. , QUADRATIC FORMULA WILL BE USED. 
IF ( N .LT. 2 ) GO TO 400 

DISCRM = COEF ( N ) * *2 - 4. * COEFCN+1) * C0EF(1) 

IF ( DISCRM .LT. 0.0 ) GO TO 600 

ROOTS (1) = (-COEF(N) + DSQRT ( D I SCRM ) ) / ( 2.*C0EF(N+1) ) 

R00TSC2) = (-COEF(N) - DSQRT ( D I SCRM) ) / ( 2.*C0EF(N+1) ) 

KNTR = 2 

Y ROOTS ( 1 ) = POLYXC COEF, N, ROOTS! 1 ) ) 

YR00TSC2) = POLYX ( COEF , N, ROOTS ( 2 ) ) 

GO TO 900 

400 CONTINUE 

KNTR = 1 

ROOTS ( 1 ) = -COEF ( 1 ) /COEF ( 2 ) 

YROOTSC 1 ) = POLYX ( COEF, N, ROOTSC 1 ) ) 

GO TO 900 


600 

C 


650 


C 

900 

C 

c 


920 

C 


CONTINUE 

I F ( IPRINT.EQ. 1 )WRITE(6, 650) N 

FORMAT ( 1 X, 1 4HN0 REAL ROOTS. . 5X, I3,19H DEGREE POLYNOMIAL. / ) 

I ERR = 1 
GO TO 2000 

CONTINUE 

IF ( I PR I NT .NE. 1 ) GO TO 2000 


WRITE ( 6,920) N 

FORMAT ( IX, 15HR00T(S) OF THE 

IF ( KNTR .GT. 8 ) GO TO 1000 


13. 18H DEGREE POLYNOMIAL ) 


C 
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WRITE ( 6,950) ( ROOTS < I) ,1=1, KNTR ) 
950 FORMAT ( 1X,8E16.8 ) 

WRITE ( 6,960 ) 

960 FORMAT ( 1X,16HTHE Y -VALUES ARE ) 

WR I TE( 6, 950 ) (YROOTSCI),! = 1 , KNTR ) 

00 TO 2000 
980 FORMAT ( IX,/ ) 

C 

1000 CONTINUE 


KNTR1 = KNTR/2 
KNTR2 = KNTR - KNTR1 

WRITE ( 6,950) ( ROOTS ( I ) ,1=1, KNTR1 ) 

KNTR1 = KNTR1 + 1 

WRITE ( 6,950) ( ROOTS ( I ) , I = KNTR1 , KNTR2 ) 

WRITEC6, 980) 

KNTR1 = KNTR1 - 1 
WRITE ( 6,960 ) 

WR I TE ( 6, 950 ) (YROOTSCI), I = 1 , KNTR1 ) 

KNTR1 = KNTR1 + 1 

WR I TE ( 6, 950 ) (YROOTSCI), I =KNTR1 , KNTR2) 


2000 CONTINUE 
C 

WRI TE( 6,25 ) 

NROOTS = KNTR 

RETURN 

END 

*DECK OUTPUT 

SUBROUTINE OUTPUT ( XD I S, DECB, ANGLES, FREQ, MI KES, NFREQ, HTMI KE ) 
C 

C* * * * * 


REAL* 8 XD I S( 1 30, 2 ) , DECB (1 30 , 35 ) , ANGLES (130). FREQ ( 33 ) 
REAL*8 HTMI KE (130) 

C 

LC = MIKES / 15 

I F ( MOD ( M I KES ,15), NE . 0 ) LC = LC + 1 
1ST = 1 

DO 375 J = 1,LC 
I STP = 1ST + 14 
IF ( ISTP.GT. MIKES) ISTP=MIKES 
C 


WRITE 
WRITE 
WRITE 
WRITE 
WRITE 
WRITE 
DO 350 


(6,610) 

(6, 620) 

(6, 625) 

(6, 630) 
(6,640) 

(6, 650) 

L= 1 , NFREQ 


( (K) ,K=I ST, I STP ) 

( ANGLES (K) , K= I ST, ISTP) 
( HTM I KECK) , K= I ST, ISTP) 
(XDISCK, 1 ),K=IST, ISTP) 
( XD I S ( K . 2) , K= I ST, ISTP) 


350 WR I TE ( 6, 670) 
WRITEC6, 710) 
WRITEC6, 720) 


FREQ(L), ( DECB( K, L ) , K= I ST, ISTP) 
( DECBCK, 34) ,K=IST, ISTP) 

( DECB(K, 35) , K= I ST, ISTP) 


WRITE (6,730) 
1ST = ISTP + 1 
375 CONTINUE 


c 


* 


610 

620 

625 

630 

640 

650 

670 

710 

720 

730 


FORMAT (12H M I CROPHONE : , 1 4X , 1 5 ( 1 X , I 3 , 2X ) ) 
FORMAT (12H ANGLE( DEG ) : , 1 4X , 1 5F6 . 1 ) 

FORMAT (13H HEIGHT ( FT ) : , 1 3X , 1 5F6 . 1 ) 
FORMAT (14H CL D I ST ( FT ) : , 1 2X , 1 5F6 . 1 ) 
FORMAT (14H REF D I ST ( FT ) : , 1 2X f 1 5F6 . 1 ) 
FORMAT (12H FREQ (HERTZ)) 

FORMAT ( 2X j F9 , Oj 1 5Xj 1 5F6 . 1 ) 

FORMAT ( 1 2HOOVERALL SPL , 1 4X, 1 5F6 . 1 ) 

FORMAT ( 5H PNDB, 21 X, 1 5F6 . 1 ) 

FORMAT ( 1 HI ) 

RETURN 

END 

DECK LCART 
SUBROUTINE LCART 


C# # # # # 
1 

2 

3 

C* * * * * 


REAL*8 DECB, ANGLES, XD IS, HTMIKE, HTSRCE, SDHUM, SDTEMP , V8, UNITS, 
THETAM, ADEL, BDEL, AN, YF, YY, ANHI , ANLO, AFHI , AFLO, 

COFA, COFB, TR, R2D, D2R, SDTEMF , TTEMP, TTEMPF , VJET , 

FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDI A 


1 

2 

3 

4 

5 

6 

7 

8 

903 

905 


909 

101 


I UN=LUN=5 

COMMON /SUB/ M I KES, M I KEA, M I KEB, I CALL, DECB( 130,35), 

ANGLES! 1 30) , XDI S ( 1 30, 2) , HTMIKE! 1 30) , HTSRCE, SDHUM, 
SDTEMP, V8, UNI TS.KFI T! 2) , IWTB, IWTE, 

THETAM (33) , ADEL, BDEL, AN, IGRC, NRUN, 

YF , Y Y , ANH I , ANLO , AFH I , AFLO, COFA (16,35), COFB (16,35), 
TR, R2D, D2R, SDTEMF, TTEMP , TTEMPF, 

I B I DO, I MRC, I BNC , IRC, IAAC, IDATE, 

VJET, FREQ ( 33) , THETAS ( 50, 33 ) , XOVERD (50, 33) , NTAB( 33) , 
NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , NZTYPE ( 1 0 ) , NFREQ 
READ (I UN, 903) NFREQ 
FORMAT (712) 

READ ( I UN, 905 ) ( FREQ ( I ) , I = 1 , NFREQ ) 

FORMAT (8F10.1) 

DO 101 J=1 .MIKES 

READ ( LUN, 909) ANGLES! J ) , (DECB( J, L) , L= 1 , NFREQ) 

FORMAT (16F5.2) 

CONTINUE 

RETURN 

END 

DECK RECHNASA 

SUBROUT I NE RECHNASA ( NFREQ, M I KES , M I KEA, M I KEB, DECB, FREQ, ANGLES ) 
COMMON/ I DENT/ I PT1 , KBNSA, I PT2 
COMMON/TITRE/LIB! 10) , I DATE! 3) , DB1 (8, 4) 

REAL*8 DECB! 1 30, 35 ) , FREQ ( 33 ) , ANGLES ( 1 30 ) 

DIMENSION ANG ( 30 ) , SPE(30) , I PAR! 2) , PAR! 8) , NZTYP(3) , FQ(30) 
DIMENSION TAB1 (13), TAB2(30) , TAB3(31 ) , TAB4(31 ) , TAB5(31 ) 


EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 


( TAB1 ( 1 ) 
(TAB2! 1 ) 
( TAB3! 1 ) 
( TAB5! 1 ) 


, IPAR! 1 ) ) 
, FQ( 1 ) ) 

, ANG! 1 ) ) 

, SPE! 1 ) ) 


( TAB1 (3) , PAR( 1 ) ) , ( TAB1 (11), NZTYP! 1 ) ) 


104 


DATA ND1 , ND2/2, 3/,NDFQ/5/,LI BO/ 4H 
I F ( KBNSA . EQ . 1 )NFREQ=25 
I F ( KBNSA . EQ . 2)NFREQ=23 
LECTURE DU POINT CONTENANT LA LIGNE 1 
READ(ND1 , 101, END=601 XTAB1 (I ), 1 = 1, 13) 
IF! IPT1 .NE. IPAR! 1 ) ) WRITE! 6, 104) IPAR( 1 ) . 
FORMAT ( ‘ ERREUR POINT LU = * , 15) 

NPO I = I PAR ( 1 ) 


STOP 
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N = I PAR ( 2 ) 

M I KEA=N 

101 FORMAT ( 31 A4 ) 

DB 1(1,1 ) =0 . 

DB1 ( 1 , 2)=PAR(5)/3. 2808 
READCND1 , 101 )<TAB2( I ) , 1=1 ,30) 

DO 10 1=1, NFREQ 
10 FREQ( 1 ) =FQ ( I +NDFQ) 

READCND1 f 101 ) ( TAB3( I ) , I = 1 , N) 

DO 20 l = 1 , N 
20 ANGLES ( I >=ANG( I ) 

READ( ND1 ,101 ) ( TAB4 ( l ) , I = 1 , N) 

DO 30 I A= 1 , N 

READ ( ND1 ,101 ) ( TABS ( I ) , I =1 , 31 ) 

DO 40 I DB= 1 , NFREQ 
40 DECBC I A, I DB ) =SPE( I DB+NDFQ) 

30 CONTINUE 

C LECTURE DU FI CHI ER CONTENANT LA LIGNE 2 

READ ( ND2, 101 , END=602 ) ( TAB1 ( I ) , I =1 , 13) 

IFC I PT2 . NE . I PARC 1 ) ) WR I TE ( 6, 1 04 ) IPAR( 1 ) ; STOP 
N= I PAR ( 2 ) 

M I KEB=N 
DB1 (3, 1 )=0. 

DB1 C3,2)=PAR(5)/3.2808 
DO 5 1=1,3 

5 L I B ( I )=NZTYPC I ) 

DO 6 1=4,10 

6 L I B ( I ) =L I BO 
DO 7 1=1,3 

7 I DATE ( I ) =0 

READ C ND2, 101 ) ( TAB2 ( I ) , I =1 , 30) 

READ ( ND2, 101 ) ( TAB3( I ) , I =1 , 30) 

DO 50 I = 1 , N 

50 ANGLES ( M I KEA+ I ) = ANG ( I ) 

R£AD( ND2, 101 ) ( TAB4 ( I ) , I = 1 , 30) 

DO 60 I A= 1 , N 

READ ( ND2, 101 ) ( TABS ( I ) , I =1 , 31 ) 

DO 70 I DB= 1 , NFREQ 

70 DECBCMIKEA+IA, IDB)=SPE( I DB+NDFQ) 

60 CONTINUE 

M I KES=M I KEA+M I KEB 
GO TO 900 

601 WRITEC6, 102)N01 

102 FORMAT (' FIN DE FICHIER ETIQ. LOGIQUE * ,12) 

STOP 

602 WR I TE ( 6 , 103)ND2 

103 FORMAT < 1 FIN DE FICHIER ETIQ. LOGIQUE ',12) 

STOP 

900 RETURN 
END 

SUBROUT I NE RECHPO I N C NFREQ , M I KES , M I KEA , M I KEB, DECB , FREQ , 
* ANGLES) 

INTERFACE PROG AMES ET PROG ONERA 

NO MICROS 


IP! ( 1 ) =0- 

7M, LIGNE 

1 ,MI 

CRO 

1 

1 

IPI < 2 ) =0- 

7M, LIGNE 

1 ,MI 

! CRO 

2 

2 

IPl ( 3 ) =0- 

7M, LIGNE 

2, Ml 

1 CRO 

1 

3 

IPI ( 4 ) =0- 

7M, LIGNE 

2, MICRO 

2 

4 

IPI ( 5 ) = 7 - 

14M, LIGNE 

1 , M 1 

1 CRO 

1 

5 
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c 
c 
c 
c 

c* # *# * 


1 PI (6)=7-14M J LIGNE 1.MICR0 2 6 
| p l ( 7 ) =7- 1 4Mj LI GNE 2.MICR0 1 7 
IPl (8)=7-14M J LIGNE 2,MICR0 2 8 


c***** 


COMMON / I DENT/NPO I , KM 1 C 

COMMON /Tl TRE/LIB( 1 0) , I DATE (3) , DB1 (8,4) . I PI (8) 


C 

C 

C 


REAL* 8 OMEGA ( 8, 40) , DECB( 130,35), FREQ ( 33) , ANGLES ( 1 30) , AMI , AMA 
REAL* 8 AUX ( 1 30 , 30 ) 

DIMENSION LTT ( 1 0 ) , JFR ( 44 ) , I RG ( 2 ) 

DIMENSION I DB1 (8, 6) , TETA( 8, 40) , SDB( 8, 40,50) 

D! MENS I ON TAB1 (050) , TAB2( 050) , I TAB( 6) , TAB (4 ) , ANQ(40) , SPE(45) 

EQU I VALENCE (TAB 1 ( 1 ) , TITR) 

EQUIVALENCE ( TAB1 ( 2 ) , I TAB ( 1 ) ) 

EQUIVALENCE ( TAB1 ( 8) , TAB( 1 ) ) 

EQUIVALENCE ( TAB1 ( 1 2) , LTT ( 1 ) ) 

EQUIVALENCE ( TAB1 ( 22) , ANG ( 1 ) ) 

EQU I VALENCE ( TAB2 ( 1 ) , ANGLE ) 

EQU I VALENCE ( TAB2 ( 2 ) , SPE ( 1 ) ) 

DATA IPI/1 ,2, 3, 4, 5, 6, 7, 8/ 

DATA JFR/3, 4,5,6, 8, 10, 12, 16,20,25,31,40,50,63,80, 1 
*250, 315,400, 500, 630, 800, 1 000, 1 250, 1 600, 2000, 2500, 31 5 ?' 

*6300, 8000, 1 0000, 1 2500, 1 6000, 20000, 25000, 31 500, 40000, 50000,63000/ 

DATA l UN/5/ 

FREQUENCE 80 A 20000HZ 

ND = 2 
NUMER =1 
REWIND ND 
50 K0DR=0 
600 CONTINUE 

READ(ND, 1 05, END=61 0) ( TAB1 ( I ), I =1 ,50) 

105 FORMAT (50A4) 

I F ( I TAB ( 1 ) . NE . NPO I )G0 TO 500 
NOUVELLE INDEXATION 
I NDEX = I TAB ( 4 ) 

MISE EN TABLEAU DU TITRE 


C 

c***«* 

12 


20 


22 


24 


DO 12 1=1,10 
L I B ( I ) =LTT ( I ) 

I DJ= l TAB ( 2 ) /4096 
I DF= I TAB(2) - I D J*4096 
I UJ= IDF/256 
I DF = I DF - I U J * 256 
I DATE( 1 ) = I DJ* 1 0+ I UJ 
I DM= I DF/1 6 
I UM= IDF- I DM* 16 
I DATE( 2 ) = I DM* 1 0+ I UM 
1 DATE( 3) =79 
DO 20 1=1,6 
IDB1 (INDEX, I ) = I TAB ( I ) 

DO 22 1=1,4 

DB1 ( INDEX, 1 ) = T AB ( I ) 

DO 24 1 = 1 , I T AB ( 5 ) 

TETA( INDEX, I )=ANG( I ) 

REMISE EN ORDRE 


DES SPECTRESB SI BANDE EN SENS INVERSE 
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c 


DO 250 LA= 1 , I TAB ( 5 ) 

IF! ITAB!6) .GT. 1 ) I A= I TAB ( 5 ) + 1 -LA ; GO TO 170 
I A = LA 

LECTURE DES SPECTRES 

170 CONTINUE 

READ( ND, 1 05, END=630) !TAB2( 11,1=1,50) 

C RANGEMENT DES ANGLES ET DES SPECTRES 

OMEGA ( I NDEX , I A ) = ANGLE 
DO 250 IDB=1 ,45 
250 SDB( I NDEX, I A, I DB) =SPE( I DB ) 

NUMER=NUMER+1 
I P ( NUMER . LE . 8 ) GO TO 50 
GO TO 700 

500 DO 25 J=1 , I TAB( 5) 

READING, 1 05, END=620 ) ( TAB2( I ) , 1=1 , 50) 

25 CONTINUE 
GO TO 600 
610 KODR= 1 

GO TO 650 
620 K0DR=2 

GO TO 650 
630 K0DR=3 

650 WRITE! 6, 1 04 )KODR; STOP 

104 FORMAT ( ’ ERREUR EN LECTURE BANDE K0DR= , ,I5) 

700 CONTINUE 

MISE EN TABLEAU DES FREQ DES ANGLES ET SPECTRES DE 0A14 METRES 
COEFFICIENTS DE CALIBRATION LIGNE 1 : Cl 1 C12 , L I ONE 2:C21 C22 
RANG DU PREMIER ANGLE LIGNE 1 ET LIGNE 2 
READ! I UN, 901 )C11,C12,C21 ,C22, IRG( 1 ), IRG<2) 

901 F0RMAT(4F5. 1 ,212) 

WRITE! 6, 801 )C1 1 ,C12,C21 , C22 
801 FORMAT!/ ' CALIBRATION LI L2 =’,4F6.1) 

RANG - 1 DE LA PREMIERE FREQ TRA1TEE 

NFDEC= 1 4 

NFREQ=25 

DO 5 1 DB= 1 , NFREQ 
5 FREQ! I DB) = JFR! I DB+NFDEC) 

CHOIX DU TRA1 TEMENT 
KM I C = 0 MICROS A+ B MOYENNES 
KM I C= 1 MICRO A 
KM I C = 2 MICRO B 


I A= I B=0 

C BOUCLE SUR LES LI ONES 

DO 800 KL I G= 1 , 2 

I F ! KM I C . NE . 0 . AND . KM I C . NE . 1 ) GO TO 1000 
C M I CRO A 

IFIKLIG.EQ. 1 ) Ml = I P I !1 );M2=IPI ! 5) ; NT1 = I DB1 !M1 , 5) 
IFIKLIG. EQ. 2)M1 = I P I ! 3 ) ; M2= I PI !7) ; NT2=IDB1 !M1 , 5) 
1=1 

LEGAL=0 

DO 10 K= 1 , I DB 1 !M1 ,5) 

K1 = I NT! OMEGA! Ml , K) +0 . 5) 

K2= I NT IOMEGA! M2, I )+0.5) 

IFIK1.EQ.K2) 1=1+1; LEGAL=LEGAL+ 1 
10 CONTINUE 

DO 30 I = I RG ! KL I G ) , I DB1 ! Ml , 5 ) 

I A= I A+ 1 

ANGLES! IA)=0MEGAIM1 , I ) 
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DO 30 I DB= 1 , NFREQ 

30 DECB ( I A, ! DB ) =SDB(M1 , 1 , I DB+NFDEC) 

DO 40 J=LEGAL + 1 , I DB1 (M2, 5) 


I A= I A+1 

ANGLES ( I A) =0MEGA(M2, J) 

DO 40 I DB= 1 , NFREQ 

40 DECB ( I A j I DB) =SDB(M2, J , 1 DB+NFDEC) 

I F ( KM I C . NE . 0 ) GO TO 2000 

1 000 I F ( KLI G . EQ ,1)M1=IPI(2); M2= IPI(6);NT1=I DB1 (Ml ,5) 
1 F (KL I G ' EQ . 2)M1=IPI (4); M2 = I PI ( 8) ; NT2= 1 DB1 (Ml ,5) 


1=1 

LEGAL =0 

DO 11 K = 1 , I DB 1 (Ml ,5) 

K1 = I NT (OMEGA (Ml , K)+0.5) 

K2= I NT (OMEGA (M2, 11+0.5) 
IF(K1.EQ.K2) 1=1+1; LEGAL=LEQAL+1 
11 CONTINUE 

DO 31 1 = I RG ( KL 1 G ) j I DB 1 (Ml , 5 ) 


I B= I B+ 1 

ANGLES ( IB) =0MEGA(M1 , I ) 

DO 31 1DB=1, NFREQ 

31 AUX( IB, I DB) =SDB(M1 ,1,1 DB+NFDEC) 
DO 41 J=LEQAL+ 1 , I DB1 (M2, 5) 


1B= 1B+1 

ANGLES ( IB)=0MEGA(M2, J) 

DO 41 I DB= 1 , NFREQ 
41 AUX( IB, I DB) =SDB(M2, J, I DB+NFDEC) 

I F ( KM I C . NE . 0 ) GO TO 3000 
I F(KLI G. EQ . 1 )M1KEA= I A; GO TO 800 
M I KES= I A 

MIKEB=M!KES-MIKEA 
C MOYENNE MICRO A + MICRO B 

DO 70 1=1, MIKES 
DO 70 I DB= 1 , NFREQ 

70 DECB(I,IDB)=(DECB(I,IDB)+AUX(I , IDB) )/2. 
GO TO 5000 

2000 I F(KLI G . EQ . 1 )M1KEA= I A; GO TO 800 
M I KES= 1 A 

M I KEB=M I KES-M I KEA 
GO TO 5000 

3000 1F(KLIG.EQ. 1 )MIKEA=IB;GO TO 800 
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800 

5000 

106 


73 


74 


75 


MI KES= I B 

M I KEB=M I KES -M I KEA 
DO 72 1=1, MI KES 
DO 72 I DB= 1 , NFREQ 
DECB ( I , I DB ) = AUX ( 1 , I DB ) 

CONTINUE 

I F (MI KES . GT . 130) WRITE (6, 1 06 ) M I KES ; STOP 
FORMAT! ' TROP D ANGLES LIGNE 1 + LIGNE 2 = 
CORRECTION DES SPECTRES 
DO 73 1=1, NT 1 
DO 73 1DB=1, NFREQ 

DB) =DECB( I , I DB) +C1 1 
I = NT 1+1 , Ml KEA 
I DB= 1 , NFREQ 
, 1 DB ) =DECB ( I , I DB ) +C1 2 
I =MI KEA+ 1 , MIKEA+NT2 
1 DB= 1 , NFREQ 
1 DB ) =DECB( I , I DB ) +C21 


DECB( I 
DO 74 
DO 74 
DECB( I 
DO 75 
DO 75 
DECB ( I 


.15 
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DO 76 1 =MI KEA+NT2+1 , MIKES 
DO 76 ! DB= 1 , NFREQ 
76 DECBCI , IDB)=DECB< I , IDB)+C22 
RETURN 
END 

*DECK CORECT 

SUBROUTINE CORECT 

I CALL = 1 FOR MIKE RESPONSE CORRECTIONS 
I CALL = 2 FOR REVERBERATION CORRECTIONS 
I CALL = 3 FOR BACKGROUND NOISE CORRECTIONS 


*x*x* 

REAL* 8 DECB, ANGLES , XDI S, HTMI KE, HTSRCE, SDHUM, SDTEMP, V8, UNI TS, 

1 THETAM, ADEL, BDEL, AN, YF, YY, ANHI , ANLO, AFHI , AFLO, 

2 COFA, COFB, TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, VJET, 

3 FREQ , THETAS , XOVERD , XDMAX , THETSM , RNZD I A 

Cx X X X X 

REAL *8 CORVAL, DUMMY 1 , DUMMY 2 

C***«* 

COMMON /SUB/ MIKES, MIKEA.MIKEB, I CALL, DECB( 1 30, 35) , 
t ANGLES ( 1 30 ) , XD I S C 1 30, 2 ) , HTM I KE ( 1 30 ) , HTSRCE , SDHUM , 

2 SDTEMP , V8, UN I TS, KF I T ( 2) , I WTB, IWTE, 

3 THETAMt 33) , ADEL, BDEL, AN, I GRC, NRUN, 

4 YF , YY, ANHI , ANLO, AFHI , AFLO, COFA1 1 6, 35) , COFB( 1 6, 35) , 

3 TR, R2D, D2R,SDTEMF, TTEMP, TTEMPF, 

6 I B I DO, I MRC, IBNC, IRC, IAAC, IDATE, 

7 VJET, FREQ 1 33 ) , THETAS ( 50, 33 ) , XOVERDI 50, 33 ) , NTAB C 33 ) , 

8 NTEST , XDMAX ( 33) , THETSM (33) , RNZDIA, NZTYPE( 10), NFREQ 
C 

REAL*8 CORR ( 1 30, 33 ) 

C 

C 

C INITIALIZE ARRAY OF CORRECTION VALUES 

C 

DO 100 J=1 , 33 
DO 100 K= 1 , 50 
100 CORRCK.J) = 0.0 
C 

REWIND 8 

GOTO (200,400,600), I CALL 
C 
C 

C THIS SECTION IS USED FOR MIKE RESPONSE CORRECTIONS 

C 

C 

200 READ (8) I RUN, I CHAN, I BAND, CORVAL, DUMMY 1 , DUMMY2 
IF ( I RUN. EQ. 0. AND. I CHAN. EQ. 0) GOTO 300 
IF ( I CHAN. LT. 1 .OR, ICHAN.GT. 50) GOTO 200 
IF ( (BAND. LT. 1 . OR. IBAND. GT. NFREQ) GOTO 200 
CORR ( I CHAN, I BAND) = CORVAL 
IF ( (ICHAN+MIKEA) .GT.50) GOTO 200 
IM = ICHAN+MIKEA 
CORR ( I M, IBAND) = CORVAL 
GOTO 200 
C 

300 WRI TE( 6, 801 ) 

801 FORMAT ( 1 HI , 1 OX, 31 HM I KE RESPONSE CORRECTION VALUES /) 

CALL OUTCOR( CORR, MI KEA, Ml KEB, NFREQ) 
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APPLY CORRECTIONS 

250 DO 225 J= 1 , NFREQ 
DO 225 K= 1 , MIKES 

225 DECB(K, J ) = DECB(K, J ) -C0RR(K, J ) 
GOTO 900 


THIS SECTION APPLIES REVERBERATION CORRECTIONS 


400 READ (8) I RUN, I CHAN, I BAND, DUMMY 1 , CORVAL, DUMMY2 
IF ( I RUN . EQ . 0 . AND . I CHAN . EQ . 0 ) GOTO 500 
IF ( 1CHAN. LT. 1 . OR. I CHAN. GT. 50) GOTO 400 
IF (IBAND.LT. 1 .OR. I BAND. GT. NFREQ) GOTO 400 
CORRC I CHAN, I BAND) = CORVAL 
IF ( ( ICHAN+MIKEA) .GT. 50) GOTO 400 
1M = ICHAN+MIKEA 
CORRC I M, I BAND) = CORVAL 
GOTO 400 

500 WR I TE (6, 802 ) 

802 FORMAT (1 HI , 1 OX, 31 HREVERBERATI ON CORRECTION VALUES /) 
CALL OUTCOR ( CORR , M I KEA, M I KEB, NFREQ ) 

GOTO 250 


APPLY BACKGOUND NOISE CORRECTIONS HERE 


600 READ (8) I RUN, I CHAN, I BAND, DUMMY 1 , DUMMY2, CORVAL 
IF ( I RUN . EQ . 0 . AND . I CHAN . EQ . 0 ) GOTO 700 
IF ( ICHAN.LT. 1 .OR. I CHAN. GT. 50) GOTO 600 
IF ( IBAND.LT. 1 .OR. I BAND. GT. NFREQ) GOTO 600 
CORR ( I CHAN, I BAND) = CORVAL 
IF (( ICHAN+MIKEA) . GT . 50) GOTO 600 
IM = ICHAN+MIKEA 
CORR( IM, (BAND) = CORVAL 
GOTO 600 

700 WRITE (6,803) 

803 FORMAT ( 1 HI , 1 OX, 34HBACKGR0UND NOISE CORRECTION VALUES /) 
CALL OUTCOR ( CORR, Ml KEA, MI KEB, NFREQ) 

GOTO 250 

SUBROUTINE EXIT 

900 RETURN 
END 

>ECK A I FAB 

SUBROUTINE A I FAB ( P , T , RH , CF , ABDBM ) 


THIS PROGRAM CALCULATES THE ABSORBTION OF SOUND IN AIR AS A 
FUNCTION OF TEMPERATURE, HUMIDITY, PRESSURE AND FREQUENCY. 

THE PROGRAM SHOULD NOT BE USED FOR CALCULATIONS OUTSIDE 

THE TEMPERATURE RANGE OF 0 DEG F (-20 DEG C) THROUGH 104 DEG F 

(40 DEG C) 
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C ABDBM = AMPLITUDE ABSORBT I ON COEFFICIENT IN DB/METER 

C ABDBSC = AMPLITUDE ABSORBT I ON COEFFICIENT IN DB/SECONDS 

C ABDBTF = AMPLITUDE ABSORBT I ON COEFFICIENT IN DB/IOOOFT 

C ABDAM = AMPLITUDE ABSORBT I ON COEFFICIENT PER WAVELENGTH 

C ALPHA = AMPLITUDE ABSORBT I ON COEFFICIENT IN NEPERS PER METER 

C 

C CF = ACOUSTIC FREQUENCY 

C P = AMBIENT PRESSURE IN ATM 

C PS * SATURATED VAPOR PRESSURE FOR WATER IN ATMOSPHERES 

C T = TEMPERATURE IN DEGREES KELVIN 

C TC = TEMPERATURE IN DEGREES CENTIGRADE 

C TF = TEMPERATURE IN DEGREES FAHRENHEIT 

C WAVEL = WAVELENGTH OF SOUND WAVE 

C 

c 

c***»* 

REAL* 8 P, Tj RH, CF, ABDBM 

REAL*8 PI , T1 , TC, TF, VEL, VELFPS, TO! , PS, H, FR02, FRN2, 

1 ALPHA, WAVEL, ABDAM, ABDBTF, ABDBSC 

C**#** 

PI = 3. 14159 
T 1 = T/293 . 

TC * T-273. 

TF = TC* 1 . 8+32. 

VEL = 343 , 4*DSQRT( T1 ) 

VELFPS = VEL*3 . 28 
TOI * 273. 16 
C 

PS * 1 0 . 79586* ( 1 . -T01/T)-5. 02808* DLOG1 0( T/T01 )+1 .50474E-4*(1 .-10. 
C**< -8.29692* ( CT/T01 ) - 1 . ) ) ) +0 . 42873E-3* ( 10. **(4 . 76955* 

C( 1 . -CT01/T) ) ) -1 . ) -2.2195983 
PS = 10. **PS 
H = PS/P*RH 

FR02 = P* C 24 .+4.41 E04*H* ( 0 . 05+H ) / ( 0 . 391 +H) ) 

FRN2 = P/DSQRTCT1 )*(9. +350. *H*DEXP( -6. 142*( ( 1 . /T1 )** . 331 -1 . ) ) ) 
ALPHA = 1 . 84E- 11+2. 1 91 3E-4/T1 *P* ( 2239. 1 /T) **2*DEXP( -2239 . 1/T) 

C / ( FR02+ ( CF* *2/FR02) ) 

ALPHA = ALPHA+8 . 1619E-4/T1*P* (3352. /T) **2*DEXP( -3352, /T) 

C / ( FRN2+ ( CF* *2/FRN2 ) ) 

ALPHA = ALPHA*DSQRT(T1 )*CF**2/P 
WAVEL = VEL/CF 
ABDAM = ALPHA*WAVEL 
ABDBTF = ALPHA*2647 . 

ABDBM = ALPHA*8. 6860 

ABDBSC = ALPHA*VEL*8. 686 

CONTINUE 

RETURN 

END 

*DECK GRNOIS 

SUBROUTINE GRNOIS ( XD I ST , HDI ST, JETN, H, TF, MI KES, FI , NFREQ ) 

C 

C CORRECTIONS FOR EACH MIKE DISTANCE AND FREQUENCY 

C SUBROUTINE TO COMPUTE GROUND REFLECTIONS 

C 

C* * * * * 

REAL*8 PI 2, DFFI , TT, A, B, C , X , HMI KE , RPR I ME , RSMALL, Z, DR, R 

0***** 

REAL* 8 LI 

REAL* 8 JETN( 1 30, 35) , XDI ST ( 1 30) , HDI ST ( 1 30) , FI (33),L<24> 

REAL* 8 TF, H 



o o o 


C 


DATA PI 2, DFFI /6. 2831 053071796,0. 1 1 5/ 


C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


PATH AND REFLECTED PATH FOR SOUND 


OF THE RESULTING 


C = SPEED OF SOUND 
DR = DIFFERENCE BETWEEN DIRECT 
H = SOURCE HEIGHT ABOVE GROUND 
HMIKE = MIKE HEIGHT ABOVE GROUND (HD I ST) 

JETN IS ARRAY CONTAINING REFLECTION INDEX 
LI = CENTER FREQUENCY WAVE LENGTH 
R IS THE RATIO OF AVERAGE QUADRATIC VALUE 
SIGNAL AND THAT OF THE MAIN SIGNAL. 

TF = TEMPERATURE, DEGREES FARENHEI T 
TT = TEMPERATURE, DEGREES RANK1NE 

X = GROUND DISTANCE BETWEEN SOURCE AND MI CROPHONE 
7 s RATIO OF REFLECTED PATH TO DIRECT PATH OF SOUND WAVE 
WHEN FI ( I ) = CENTER FREQUENCY OF 1/3 OCTAVE BAND THEN ™j-j B £ND 
WIDTH IS .23 TIMES THE CENTER FREQUENCY. FOR INSTANCE THE BAND 
WIDTH FOR 50 HZ WOULD BE 11.5. OLD EQUATION WAS DF = . 23 * FI CM 
QPFI s DF/ ( I . * Fill) WHICH SIMPLIFIES TO DFFI = 0.115 


TT = TF + 459.7 
A = PI 2 * DFFI 

B = PI 2 * DSQRT (1.0 + DFFI * DFFI) 

C = 49.01* DSQRT (TT) 

DO 10 I =1 j NFREQ 
10 L( I ) = C/FI ( I ) 

DO 100 M = 1 .MIKES 
X = XDIST(M) 

HMIKE = HDIST(M) 

RPR I ME = DSQRT ( ( H ♦ HMIKE)**2 + X**2> 

RSMALL = DSQRT ( ( H - HMIKE) **2 + X**2) 

Z = RPR I ME/RSMALL 
DR = RPR l ME - RSMALL 
IF (DR.EQ.O.O) DR=0. 001 
IF CZ.EQ.O.O) Z = 0.001 
DO 50 1=1, NFREQ 

R 1 = = 1 L i I ( !/ Z **2) + 2*DSIN(A*(DR/L1 ) ) *DCOS(B* ( DR/LI ))/( Z* (A* ( DR/LI ) 

*) ) 

IF (R.LT.0,0) GOTO 50 
JETNCM, I ) = 1 0 . 0*DL0G1 OCR) 

50 CONTINUE 
100 CONTINUE 


RETURN 

END 

*DECK OUTCOR 

SUBROUTINE 


OUTCOR ( CORR , M I KEA , M I KEB , NFREQ ) 


THIS SUBROUTINE PRINTS OUT THE ARRAY •CORR' FOR NEAR AND FAR FIELDS 


£ UK JK 4 £ g 

REAL*8 CORRC 1 30, 33) 


C 

400 FORMAT ( 1 HI ) 
C 

MIC = MIKEA 


C 
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C J=1 FOR NEAR-SI DEL I NE MIKES (MIKEA). 

C J = 2 FOR FAR-SI DELI NE MIKES (MI KEB ) , 

C 

IF ( MIC .GT. 13 ) MIC = 13 
MICADD = MIC 
MICNUM = MIC 
Ml * 1 
C 

DO 2000 J = 1 , 2 
C 
C 

IF ( J .EQ. 1 ) WRITE ( 6,430) 

430 FORMAT ( 1 HO , 30X, 23HNEAR FIELD MICROPHONES. /) 

IF ( J .EQ. 2 ) WRITE ( 6,460) 

460 FORMAT ( 1H1,50X,23H FAR FIELD MICROPHONES. / ) 
C 

N1 = 1 

MICNUM = MICADD 
C 

C L = 1 FOR THE 1ST 13 MIKES. 

C L*2 FOR THE REST OF THE MIKES. 

C 

DO 1300 L = 1 , 2 
C 

IFCL.EQ. 1 )WRITE(6,300) (1,1 = N1 , MICNUM ) 

500 FORMAT (5X,8HM IKE , 8 ( I 1 , 8X ) , I 1 , 04 ( 7X , 12) ) 

IFCL.EQ. 2)WRITE(6, 350) (1,1 = N1 , MICNUM ) 

530 FORMAT ( 5X,7HMIKE , I2,11(7X,!2) ) 

WRI TE ( 6, 600 ) 

600 FORMAT (IX, 4HBAND , / ) 

C 

C 

C 1 K ' REFERS TO THE MIKE NUMBER. 

C * 1 ‘ REFERS TO THE BAND NUMBER. 

C 

DO 1000 1=1, NFREQ 
C 

WRI TEC 6, 900) I , (CORR(K,I) , K = Ml, MIC ) 

900 FORMAT ( 2X, I 2, 4X, F7 . 2, 1 2 ( 2X, F7 . 2 ) ) 

1000 CONTINUE 
C 

IF ( MIKEA .EQ. MICADD ) GO TO 1700 
Ml = MIC + 1 
N1 = MICNUM + 1 
MIC = MIKEA * J 
MICNUM = MIKEA 
C 
C 

WR I TE ( 6 , 400 ) 

C 

1500 CONTINUE 
C 

1700 CONTINUE 
C 

N1 = 1 

Ml = MIKEA + 1 
MIC = MIKEA + MICADD 
C 

2000 CONTINUE 
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WRITEC6.400) 

C 

RETURN 

END 

•DECK POLYX 

REAL* 8 FUNCTION POLYX ( COF , KFI T, X) 

EVALUATE POLYNOMIAL OF ARBITRARY ORDER 
USING HORNER'S RULE. 

COF - COFF I C I ENTS OF POLYNOMIAL 

POLYX = COF ( 1 ) + COF(2)*X + COF(3)*X**2 ♦ 
(KFIT + 1 = NUMBER OF COEFF I F I CENTS . ) 

KFIT - HIGHEST POWER OF POLYNOMIAL 

X - VALUE OF INDEPENDENT VARIABLE AT WHICH 
POLYNOMIAL IS TO BE EVALUATED. C 

***** 

REAL*8 COF (16) 

REAL* 8 SUM, X 

***** 

NP1 =KFI T + 1 
SUM = COF(NPI) 

IF (KFIT.EQ.O) GOTO 20 

DO 10 I *1 , KFIT 
J = NP1 - 1 

SUM=COF( J)+SUM*X 
10 CONTINUE 

20 POLYX = SUM 
RETURN 
END 

DECK COMP 

SUBROUTINE COMP (Y1 J Y2,T11 J TI2 J TS J X1 ) 


***** 

REAL* 8 D2R, TERM1 , TERM2, TERM3, P2, PI , ADD 
REAL* 8 TI 1 ,TI2, TS, XI , Y 1 , Y2 

***** 

DATA D2R /O . 01 7453293/ 


TERM1 = DTAN( { 1 80 . -T I 2) *D2R) 

TERM2 = DTAN( ( 180. -TI 1 )*D2R) 

IF CTERM1 . EQ. 0. .OR. TERM2. EQ. 0. ) GOTO 999 
P2 = ( Y2/TERM1 ) - ( Y 1 /TERM2) 

TERM3 = CY2/Y1 ) -1 . 0 
IF (TERM3. EQ. 0. ) GOTO 999 
PI = P2/TERM3 
XI = (Y1 /TERM2) -PI 
IF CPI . LT . 0 . ) ADD=0. 

IF (PI .GE. 0. ) ADD= 1 80 . 

TS = - 1 . 0* C DATANC Y 1 /PI ) /D2R) + ADD 
RETURN 

999 XI = 0.0 
TS = 0.0 
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NO* — * <- CVI O ^ IO (0 N <0 


RETURN 

END 

*DECK DIRECT 

Subroutine direct 
c 
c 

C DETERMINE THE NEAR FIELD/FAR FIELD 

C DIRECTIVITY RELATIONSHIP 

C 

C****« 

REAL*© DECB, ANGLES, XDI S, HTMI KE, HTSRCE, SDHUM, SDTEMP, V0, UNITS, 

1 THETAM, ADEL, BDEL, AN, YF, YY, ANHI , ANLO, AFHI , AFLO, 

COFA, COFB , TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, VJET, 

FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDI A 

REAL*© STR, DFMAX, XPEAKN, XPEAKF 

REAL*© XMAXN, YMAXN, XMAXF, YMAXF, TS, XI , D I FMAX , S, XNEAR, 

XFAR, FACT, XGUESS, YNEAR, YFAR 

COMMON /SUB/ MIKES, MIKEA, Ml KEB, I CALL, DECB( 130, 35) , 

ANGLES (1 30 ) , XD I S ( 1 30 , 2 ) , HTM I KE C 1 30 ) , HTSRCE , SDHUM , 
SDTEMP, V8, UNI TS, KF I T< 2) , IWTB, IWTE, 

THETAM ( 33 ) , ADEL, BDEL, AN, I GRC, NRUN, 

YF, YY,ANHI , ANL0, AFHI ,AFL0,C0FA( 16,35), C0FB( 16, 35) , 
TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, 

I B I DO , I MRC, IBNC, IRC, IAAC, IDATE, 

V JET , FREQ ( 33 ) , THETAS ( 50 , 33 ) , XOVERD (50,33), NTAB ( 33 ) , 
NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , N2TYPE (10), NFREQ 
COMMON/TABD/STR ( 33 ) , DFMAX ( 33 ) , XPEAKN ( 33 ) , XPEAKF ( 33 ) 

C 

REAL*© XTF ( 50, 2 ) , XTN ( 50, 2 ) 

DIMENSION NANGT ( 2 ) 

C 

C NFREQ = NUMBER OF FREQUENCIES UNDER CONSIDERATION 

C 

NANGT ( 1 ) = 0 
NANGT ( 2 ) = 0 
DO 2000 N=1, NFREQ 
M = 0 
C 

C FIND PEAK SPL'S FOR A GIVEN FREQUENCY 

C FOR BOTH NEAR FIELD AND FAR FI ELD. P 

C (CONSIDER OASPL AND PNL JUST ANOTHER SET OF 

C FREQUENCY DATA) 

C 

CALL FNDMAX ( COFA ( 1 , N ) , KF I T ( 2 ) , ANH I , ANLO, XMAXN , YMAXN , NOMAX ) 

IF (NOMAX. EQ.1) GOTO 1600 

CALL FNDMAX ( COFB ( 1 , N ) , KF I T ( 2 ) , AFH I , AFLO , XMAXF, YMAXF , NOMAX ) 

IF ( NOMAX .EQ.1) GOTO 1600 
C 

C COMPUTE X/D AND THETAS MAX VALUES FOR 

C PEAKS OF CURVES OF N-TH FREQUENCY 

C 

CALL COMP(AN,YF, XMAXN, XMAXF, TS, XI ) 

XDMAX ( N) = X1/RNZDIA 
THETSM(N) = TS 
D I FMAX= YMAXN- YMAXF 
S = FREQ ( N ) *RNZD I A/V6 
DFMAX ( N ) =D I FMAX 
STR(N)=S 
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XPEAKN ( N ) =XMAXN 
XPEAKF ( N ) = XMAXF 

WRITE (6,1002) S, FREQ(N) , 01 FMAX, AN, ADEL, YF, BDEL, XMAXN, XMAXF, 

1 THETSM ( N ) , XDMAX ( N ) 

00 THROUGH THIS PROCESS TWICE. 

L = 1 TO RIGHT OF PEAK 
L = 2 TO LEFT OF PEAK. 

DO 1000 L= 1 , 2 
XNEAR=XMAXN 
XFAR=XMAXF 
NANG-0 
FACT= 1 .0 

IF(L.EQ.2)FACT=-1 .0 
200 CONTINUE 

TAKE A STEP IN THE NEAR FIELD 
AWAY FROM THE PEAK 

XNEAR=XNEAR + FACT*ADEL 

I F ( XNEAR . GT . ANH I . OR . XNEAR . LT . ANLO ) GO TO 500 
XGUESS=XFAR + FACT*BDEL 

FIND THE CORRESPONDING NEAR FIELD SPL 

YNEAR= POLYX ( COFA (1,N),KFIT(2), XNEAR ) 

FIND THE FAR FIELD ANGLE WHICH GIVES 

THE PROPER NEAR FIELD/FAR FIELD SPL DIFFERENCE 

YFAR=YNEAR-DI FMAX 

CALL F1NDY(C0FB( 1 , N) , KFI T(2) , XFAR, Y FAR, XGUESS, XMAXF, 

1 AFLO, AFHI , FACT , KO) 

IF(KO.EQ.O)GO TO 500 

IF KO .NE. 0 WE FOUND THE PROPER ANGLE. 

NANG=NANG+1 

SAVE ANGLES IN TEMPORARY ARRAYS BECAUSE 
THEY ARE IN THE WRONG ORDER FOR PLOTTING, 

REARRANGE THEM LATER. 

XTF ( NANG, L) =XFAR 
XTNCNANG, L) =XNEAR 
NANGT (L) =NANG 
IF (NANG. EQ. 50) GOTO 1000 
GO TO 200 
500 CONTINUE 

KO = 0 THEREFORE WE EITHER RAN OUT OF ANGLES OR COULDNT FIND ONE 
OR NEAR FIELD ANGLE REQUESTED WAS OUT OF RANGE. 

1000 CONTINUE 

REARRANGE ANGLE ARRAYS TO PUT I N PROPER ORDER 

N1 =NANGT(2) 

1 F(N1 . EQ . 0)G0 TO 1600 
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c 

C DO LEFT OF PEAK FIRST 

C 

DO 1500 J=1 , N1 
K = N1 + 1 - J 
M = M+ 1 

C COMPUTE X/D AND THETAS AND STORE 

CALL COMP (AN, YF, XTN(K, 2) , XTF (K, 2) , TS, XI ) 

XOVERD (M, N ) = X1/RNZDIA 
THETASCM, N ) = TS 

WR 1 TE (6, 1004) M,XTN(K, 2) , XTF(K, 2) , TS, XOVERDCM, N) 

IF (M.EQ.50) OOTO 1800 
1500 CONTINUE 
1600 CONTINUE 
C 

C DO RIGHT OF PEAK NEXT 

N2=NANGT ( 1 ) 

I F ( N2 , EQ . 0 )G0 TO 1800 
DO 1700 J=1 , N2 
M=M+ 1 

C COMPUTE X/D AND THETAS AND STORE 

CALL COMP (AN, YF i XTN( J, 1 ) ,XTF( J, 1 ) , TS J XI ) 

XOVERDCM, N ) = X1/RNZDIA 
THETASCM, N) = TS 

WR I TE (6, 1004) M , XTN ( J , 1 ),XTF(J, 1 ) , TS, XOVERD (M, N) 

IF (M.EQ.50) GOTO 1800 
1700 CONTINUE 
1800 CONTINUE 
NTAB ( N) =M 

IF (M.EQ.O) WRITEC6, 1001 ) FREQ(N) 

IF (M.NE.O) WRITEC6, 1003) M 
2000 CONTINUE 
C 

RETURN 

C 

1001 FORMAT ( 1 HO, 27HN0 PEAK FOUND FOR FREQUENCY, F9 . 0) 

1002 FORMAT ( 1 HI / 1 OX, 1 4HSTR0UHAL NO. = , F7.2 / 1 OX , 1 1 HFREQUENCY = , 

1 F10. 1//10X, 1 7HD I FFERENCE MAX = ,F6.2// 10X, 

2 15HNEAR SIDELINE =,F6.1,3H FT, 1 6X, 6HADEL =,F6.2 / 10X, 

3 15HFAR SIDELINE = , F6 . 1 , 3H FT, 1 6X, 6HBDEL =,F6.2 // 26X,4HNEAR, 

4 1 OX, 3HFAR / 10X,10HPEAK ( DEG ) , FI 1 . 2, 2X, FI 1 . 2 / / 1 OX, 7HTHETA-S, 

5 3X, FI 1 .2, / 1 OX, 3HX/D, 7X, FI 1 .2, // IX, 

6 33HRESULTS OF TABULATED ANGLE PAIRS //20X, 4HNEAR, 8X, 3HFAR / 

7 1 OX, 3HN0. , 1 X, 2( 6X, 5HTHETA) , 6X, 7HTHETA-S, 8X, 3HX/D / 9X, 

8 4(1H-),2( 5X, 7( 1 H- ) ),4X,9(1H-), 6X, 5( 1 H- ) /) 

1003 FORMAT ( // 5X, 6HNTAB =,13) 

1 004 FORMAT ( 1 OX, I 2, 6X, F7 . 2, 5X, F7. 2, 5X, F6. 2, 7X, F6. 2) 


C 

END 

SUBROUTINE STAB ( NFREQ, FREQ, THETSM, XDMAX ) 

C****« 

REAL*8 STR, DFMAX, XPEAKN, XPEAKF 

COMMON/ TABD/STR ( 33 ) , DFMAX ( 33 ) , XPEAKN ( 33 ) , XPEAKF ( 33 ) 
REAL* 8 FREQ ( 1 ), THETSM (1 ), XDMAX (1 ) 

C ECRITURE RESULTATS 

WR I TEC 6, 105) 

DO 10 1=1, NFREQ 

10 WRITEC6, 101 ) STR( I ) , FREQ( I ) , THETSM ( I ) ,XDMAX( I ) , DFMAX ( 1 ) , 



1XPEAKNC I ) , XPEAKF ( I ) 

103 FORMAT ( 1 HI , 1 STROUHAL FREQUENCE THETAS X/D DIFMAX PEAKN 

1 PEAKF (DEG)') 

101 FORMAT (IX, 7F9 . 2 ) 

RETURN 

END 

*DECK FINDY 

SUBROUT I NE FI NDY ( COF, KF I T, XF I ND, YF I ND , XGUESS , XMAX , XLO , XH I , 

DRCTNj KO ) 

C 

c 

C - 

c 

C GIVEN A POLYNOMIAL OF ORDER KFIT IN 1 INDEPENDENT VARIABLE, THIS 

C SUBROUTINE WILL DETERMINE THE VALUE OF THE INDEPENDENT VARIABLE (X) 

C CORRESPONDING TO A KNOWN VALUE OF THE DEPENDENT VARIABLE C Y ) . X IS 

C FOUND VIA ITERATION USING THE NEWTON -RAPHSON METHOD OF FINDING 

C ROOTS OF EQUATIONS IN ONE VARIABLE. 

C 

C COF = ARRAY OF COEFFICIENTS OF X I N INCREASING ORDER 

C KFIT = HIGHEST DEGREE (ORDER) OF X 

C XFIND = THE VALUE FOUND FOR X 

C YFIND = THE VALUE OF Y FOR WHICH X IS TO BE DETERMINED 

C XGUESS = INITIAL GUESS FOR X (MAY OR MAY NOT CONVERGE) 

C XLO = LOWER LIMIT VALUE FOR X 

C XH I = HIGHER LIMIT VALUE FOR X 

C XMAX = LARGEST VALUE OF X OVER THE INTERVAL XLO.XHI 

C DRCTN = POSITIVE IF SLOPE OF CURVE IS POS & NEG IF SLOPE IS NEG 

C KO = 1 IF THE VALUE OF X I S SUCCESSFULLY FOUND 

C OIF THE ITERATION DIVERGES & NO X VALUE IS FOUND 

C 

C 

c 

Q DC ft # X 4 

REAL*8 XFIND, YFIND, XGUESS, XMAX, XLO, XH I .DRCTN 

REAL *8 XN, DELTA, Cl , FX, FXD.XN1 , DEL, XB, XE, FXD2, AGUESS 

c* * * * * 

COMMON /OUTFLG/ I PFRQC, I PANGL, I PFNDM, I PROOT, I PFNDY 
C 

REAL* 8 COF (16), COFD (16), C0FD2 (16) 

C 

C INITIALIZE PROGRAM VARIABLES 

KO = 1 

I FLAG = 0 
XN = XGUESS 

II = KFIT+1 
KFITD = KFIT-1 
DELTA = 1 . OE-6 
DO 50 K= 1 , 2 
COFD(K) = 0.0 

50 C0FD2 ( K ) = 0.0 


C 

C FIND THE FIRST DERIVATIVE OF F(X) AND PLACE THE CALCULATED 

C C0EFF1 CEI ENTS INTO COFD ARRAY IN ASCENDING ORDER OF POWERS 

C OF THE INDEPENDENT VARIABLE. 

C 

DO 100 I =2, I 1 

COFD ( I - 1 ) = COF ( I ) * ( I - 1 ) 

100 CONTINUE 

Cl = COF ( 1 ) 


oooooooooo oooooo 


COF( 1 ) 


COF ( 1 ) -YF l ND 


ITERATE FOR NEW APPROXIMATIONS OF XFIND. ITERATE A LIMIT OF 20 
TIMES OR UNTIL NEW & OLD APPROXIMATIONS AGREE TO 6 DECIMAL 
PLACES. IF THE NEW VALUES DIVERGE, GOTO 600 AND COMPUTE A NEW 
INITIAL GUESS FOR XGUESS . 

150 DO 200 J = 1 , 20 

FX = POLYX ( COF, KF I T, XN ) 

FXD = POLYX ( COFD, KF I TO, XN ) 

XN1 = XN“ ( FX/FXD ) 

IF (XN1 .GT.XHI .0R.XN1 .LT.XLO) GOTO 600 
IF (XN1 .GT, XMAX.AND.DRCTN.LT. 0) GOTO 600 
IF (XN1 .LT.XMAX. AND . DRCTN . GT . 0) GOTO 600 
DEL = XN1-XN 

IF ( DABS ( DEL ). LE. DELTA) GOTO 300 
XN = XN1 
200 CONTINUE 
GOTO 400 
300 XFIND = XN1 
GOTO 500 


FIND A NEW INITIAL GUESS FOR XGUESS. USE SECOND DERIVATIVE 
TEST ON SUCCESSIVE INTERVALS OF X-RANGE UNTIL FIRST X VALUE TO 
PASS THE TEST IS FOUND. THEN BEGIN ITERATION OVER AGAIN. 

THE ITERATION WILL CONVERGE WHEN: 

DABS ( ( F( X) #F 1 ' ( X ) ) /F * ( X ) # #2 ) < 1.0 

600 IF ( I FLAG . EQ . 1 ) GOTO 400 
I FLAG = 1 
KFITD2 = KFITD-1 
I 2=KF I T 

IF ( 12. LT. 1 ) GOTO 400 

IF ( 12. EQ. 1 ) 12=2 

DO 605 1=2,12 

C0FD2 ( I -1 ) = COFDC I )*( I -1 ) 

605 CONTINUE 

IF (DRCTN) 610,400,620 
610 XB = XLO 
XE = XMAX 
GOTO 625 
620 XB = XMAX 
XE = XHI 

625 MOVE = DABS ( XE -XB ) /20 . 0 
DO 650 K= 1 , 20 
XB = XB+MOVE 
FX = POLYX ( COF, KF I T , XB ) 

FXD = POLYX ( COFD, KF I TD, XB) 

FXD2 = POLYX ( C0FD2 , KF I TD2, XB ) 

AGUESS = CFX*FXD2)/(FXD*FXD> 

IF ( DABS( AGUESS ). LT. 1 . 0) GOTO 660 
650 CONTINUE 
GOTO 400 
660 XN = AGUESS 
GOTO 150 

400 KO = 0 


84 



500 COF ( 1 ) = Cl 

IF ( IPFNDY.EQ.O) GOTO 800 
WRITE(6,700) XFIND, YFIND.KO 

700 FORMAT ( 1 X , 9HSUB FI NDY, 6X, 7HXFI ND = , FI 1 . 6, 4X, 7HYFI ND =,F11.6,4X, 

4HK0 = ,14) 

800 RETURN 
END 

*DECK FNDMAX 

SUBROUT I NE FNDMAX ( COF, KF I T , XH l , XLO , XMAX, YMAX, NOMAX ) 

C 

C 

C GIVEN A POLYNOMIAL OF ARBITRARY ORDER, THIS SUBROUTINE WILL FIND THE 

C VALUE OF THE INDEPENDENT VARIABLE (X) WHICH, WHEN EVALUATED, GIVES 

C THE MAXIMUM POSITIVE VALUE OF THE DEPENDENT VARIABLE <Y) OVER THE 

C SPECIFIED INTERVAL (XLO <= X < = XHI). 

C 

c 

c COF = POLYNOMIAL COEFFICIENTS IN ASCENDING ORDER 

C KFIT = DEGREE OF FIT OF POLYNOMIAL (ORDER) 

C XHI = HIGHEST VALUE WHICH X CAN TAKE ON 

C XLO = LOWEST VALUE WHICH X CAN TAKE ON 

C XMAX = MAXIMUM VALUE OF X OVER THE INTERVAL SPECIFIED BY XLO, XHI 

C YMAX = HIGHEST VALUE OF Y OVER THE INTERVAL FOR X 

C NOMAX = FLAG - 1 = NO MAX VALUE FOUND FOR X, 0 = MAX VALUE FOUND OK 

C D = COEFFICIENTS OF THE 1ST DERIVATIVE (ASCENDING ORDER) 

C ROOT = ROOTS OF THE 1ST DERIVATIVE 

C 

C 

REAL* 8 XH I j XLO , XMAX , YMAX 
REAL*8 R, V 

QXXtlX 

COMMON /GUTFLG/ I PFRQC, I PANGL, I PFNDM, I PROOT, I PFNDY 
REAL*8 COF ( 16) ; DH6) , ROOT (16) 

NOMAX = 0 
J1 = KFIT+1 
C 
C 

C GENERATE 1ST DERIV FOR THE GIVEN POLYNOMIAL 

C 

L = 0 

DO 200 J = 2,J1 
L = L + 1 
D ( L) = L * COF(J) 

200 CONTINUE 
C 

C FIND ALL THE ROOTS OF THE DERIVATIVE 

C 

N = KFIT-1 

CALL ZEROS(N, D, XLO, XH! , ROOT, NROOTS, IER, I PROOT ) 

IF ( IER. NE. 0) GOTO 700 
C 

C FOR EACH ROOT IN THE INTERVAL , TEST FOR MAXIMUM Y VALUE 

C 

XMAX = -1E5 
YMAX = -1E5 
DO 300 I = 1 j N 
C 


C 


R = ROOT ( I ) 


IF (R.GT.XHI .OR.R.LT.XLO) GOTO 300 

Y = POLY X ( COF , KF I T , R ) 

IF (Y.LT.YMAX) GOTO 300 
XMAX = R 

YMAX = Y 
300 CONTINUE 
C 

C TEST THE ENDPOINTS OF THE INTERVAL. IF NO ROOTS OF THE 

C DERIVATIVE FALL WITHIN THE INTERVAL, THEN ONE OF THE ENDPOINTS 

C CAN BE A LOCAL MAXIMUM, OR IF THE CURVE IS INCREASING ON THE 

C INTERVAL AFTER A LOCAL MAX, THE ENDPOINT MAY BE A MAX FOR THE INTERVAL. 

C 

Y = POLYX ( COF, KF I T, XLO ) 

IF (Y.LT.YMAX) GOTO 400 
XMAX = XLO 

YMAX = Y 

400 Y = POLYX ( COF , KFI T, XH I ) 

IF (Y.LT.YMAX) GOTO 500 
XMAX = XHI 
YMAX = Y 
700 NOMAX = 1 

500 CONTINUE 

IF ( IPFNDM.EQ.O) GOTO 600 
WRI TE( 6, 501 ) XMAX, YMAX, NOMAX 

501 FORMAT ( IX, 1 OHSUB FNDMAX, 5X, 6HXMAX - , FI 0 . 5, 4X , 6HYMAX =,F10.5,4X, 

7HN0MAX = , I 4 ) 

600 RETURN 
END 

♦DECK KURVFT 

SUBROUTINE KURVFT ( KL I SF ) 

C 

c** * * * 

REAL#8 DECB, ANGLES, XD I S, HTMIKE, HTSRCE, SDHUM, SDTEMP, VS, UNITS, 

1 THETAM, ADEL, BDEL, AN, YF, YY , ANHI , ANLO, AFHI , AFLO, 

2 COFA, COFB, TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, VJET, 

3 FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDI A 
0* * * * * 

COMMON /SUB/ MIKES, MIKEA, MIKEB, I CALL, DECB ( 1 30, 35) , 

1 ANGLES ( 1 30) , XD I SCI 30, 2) , HTMI KE( 130), HTSRCE, SDHUM, 

2 SDTEMP, V8, UNITS, KFITC2), IWTB, IWTE, 

3 THETAM ( 33 ) , ADEL, BDEL, AN, I GRC, NRUN, 

4 YF, YY, ANHI , ANLO, AFHI , AFLO, COFA( 1 6, 35 ) , COFB ( 1 6, 35) , 

5 TR, R2D, D2R, SDTEMF, TTEMP, TTEMPF, 

6 I B I DO, I MRC, 1 BNC, IRC, 1AAC, I DATE, 

7 V JET , FREQ ( 33 ) , THETAS ( 50 , 33 ) , XOVERD ( 50, 33 ) , NTAB ( 33 ) , 

8 NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , NZTYPE (10), NFREQ 
REAL*8 TEMP (70) , TFRQC(70) , U( 16) , C(70) , T0L(2) , U2( 1 6) 

REAL*8 PCT, FI 

C*«««* 

c 

COMMON /OUTFLG/ IPFRQC, IPANGL, IPFNDM, IPROOT, I PFNDY 
DATA TOL /6. 0,4.0/ 

I PRINT = 0 

I F ( KL I SF . NE . 0 ) GO TO 1000 
C 

C BEGIN BY CURVE- FITTING DECIBELS VS FREQUENCY FOR EACH MIKE. 

C OBTAIN NEW Y VALUES (DECIBELS) FOR EACH CURVE AND STORE THEM 

C IN PLACE OF THE OLD UNCORRECTED DECIBEL VALUES FOR EACH MIKE. 

C 
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c 


DO 20 J=1 , MIKES 

IF( 1WTB.EQ.0 .AND. IWTE.EO.O ) SO TO 34 


SET UP THE ARRAYS WITH WEIGHTED POINTS 

IWTBS1 = I WTB - 1 
DO 25 K = 1 , I WTBS1 
TEMPI K) =DECB( J, K) 

TFRQC(K) =DFLOAT(K) 

25 CONTINUE 
MM = I WTB 

DO 28 L = I WTB , NFREQ 
DO 30 M= 1 , 2 

IFCL.GT. I WTE. AND. M. EQ. 2) GO TO 30 
TEMP (MM) = DECB(J.L) 

TFRQC(MM) = DFLOAT(L) 

MM = MM+1 
30 CONTINUE 
28 CONTINUE 
MM = MM- 1 
GO TO 40 


34 CONTINUE 
MM = 0 

DO 35 L = 1 , NFREQ 

MM = MM + 1 
TEMP (MM) = DECB ( J , L ) 
TFRQC(MM) = DFLOAT(L) 

35 CONTINUE 


40 CONTINUE 


IF ( IPFRQC.GT. 0) I PR I NT = 1 

CALL POLFI T(TFRQC, TEMP, MM, KFI T( 1 ),U,C, IPRINT) 

KONE = KF I T ( 1 ) +1 
DO 92 LB = 1 , KONE 
92 U2(LB) = U(LB) 

THROW OUT BAD POINTS (DEVIATION > 5%) AND REFIT WHATS LEFT 


MCOUNT=MM 
MINPTS = MM- (MM/3) 

IF ( IPFRQC.NE.2) IPRINT = 0 
DO 32 11=1,2 
ICH = 0 


PASS THRU THE LIST OF X.Y PAIRS 

ZERO OUT THE POINTS WHICH EXCEED THE DEVIATION TOLERANCE 
BUT DON'T DELETE MORE THAN 6 POINTS 


DO 44 I J=1 , MM 

PCT = (TEMP( I J) “C( I J) )*1 00. 0/C( I J ) 
IF (ABS(PCT) . LT. TOL( I I ) ) GOTO 44 
MCOUNT = MCOUNT - 1 
IF ( MCOUNT. LE. MINPTS) GOTO 42 
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TEMPUJ) =0.0 
TFRQC(IJ) = 0.0 
I CH = 1 
44 CONTINUE 
I B= 1 

42 IF (ICH.EQ.O) GOTO 33 

DELETE THE BAD POINTS & MOVE THE ARRAY CONTENTS UP 


LAST = MM 
KNT = 0 

220 KNT = KNT + 1 

IF ( KNT .GT. LAST ) GOTO 225 

IF ( TEMP(KNT) , NE. 0.0 ) GO TO 220 

LAST = LAST - 1 

DO 230 KK = KNT , LAST 
TEMP(KK) = TEMPCKK+1 ) 

230 TFRQC(KK) = TFRQCCKK+1 ) 

GOTO 220 
225 CONTINUE 
MM = LAST 


CALL POLFIT ( TFRQC , TEMP , LAST, KFI T( 1) , U, C, I PRI NT) 

DO 96 LB=1 J K0NE 
96 U2( LB ) = U( LB ) 

32 CONTINUE 

33 DO 60 1=1 , NFREQ 
FI = DFLOAT ( I ) 

DECB ( J , l ) = POLYX ( U2, KF I T ( 1 ) , F I ) 

60 CONTINUE 
20 CONTINUE 
000 CONTINUE 

CALL SUBROUTINES TO CALCULATE NEW PNL & OASPL VALUES 

CALL SUBPDB (MI KES, DECB, NFREQ) 

CALL OSPL ( DECB, MIKES, NFREQ ) 


FIT THE CURVE SPL VS. ANGLES FOR BOTH SI DELI NEA AND SI DEL I NEB 
MIKES. STORE THE COEFFICIENTS IN COFA $ COFB ARRAYS BY COLUMN. 
REPLACE THE UNCORRECTED DECIBEL VALUES IN SDLNA & SDLNB 

K = MlKEA+1 
K2 = KF I T< 2) + 1 
DO 120 1=1, NFREQ 
I PR I NT = 0 

IF (MIKEA.EQ.O) GOTO 155 

IF (IPANGL.EQ. 1 .OR. IPANGL.EQ.3) I PRI NT = 1 

CALL POLFIT (ANGLES, DECB ( 1 , I ) , M I KEA, KF I T ( 2 ) , U, C, I PR I NT) 

DO 140 J= 1 , MI KEA 
DECB ( J , I ) = C( J) 

140 CONTINUE 

DO 200 L= 1 , K2 
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cofa(l, n = U ( L ) 

200 CONTINUE 

155 IF (MIKEB.EQ.O) GOTO 120 
IPRINT =0 

IF ( I PANGL. EQ. 2. OR. IPANGL. EQ. 3) IPRINT 
CALL POLF I T ( ANGLES ( K ) , DECB ( K , I ) , M I KEB , 
DO 160 J=1 , MI KEB 
J2 = J + MIKEA 
DECB( J2, I ) = C( J) 

160 CONTINUE 


= 1 

KFI T(2) , U, C, IPRINT) 


DO 180 L= 1 , K2 
COFB ( L, I ) = U(L) 

180 CONTINUE 
120 CONTINUE 

CALL SUBPDB (MIKES, DECB, NFREQ) 
CALL OSPL ( DECB , M I KES , NFREQ ) 
RETURN 
END 

*DECK POLF IT 

SUBROUTINE POLF I T ( X, Y , M , N, U, C, IP) 


PURPOSE: TO PERFORM A LEAST SQUARES POLYNOMIAL 

CURVE FIT OF DEGREE N USING M GIVEN POINTS. 


X 

Y 

M 

N 

U 

C 

IP 


THE ARRAY CONTAINING THE X COORDINATES 
THE ARRAY CONTAINING THE Y COORDINATES 
THE NUMBER OF POINTS TO BE FIT (LIMIT IS 100) 

THE DEGREE OF FIT (LIMIT IS 15) 

ON RETURN THE ARRAY OF N+1 COEFFICIENTS 

ON RETURN THE ARRAY OF CORRECTED Y COORDI NATES 

PRINT FLAG -- 1 =0N (RESULTS ARE PRINTED) ,0=0FF(N0 OUTPUT) 


THIS DECK IS INTENDED FOR USE ON THE CDC 7600. IF THIS PROGRAM 
IS BEING USED ON TSS/360, REPLACE THE DIMENSION ARRAY1(13), 
ARRAY 2 ( 1 2) CARD WITH : 

DOUBLE PRECISION ARRAY1 (13), ARRAY2( 1 2) 


Q >K $ X He He 

REAL *8 X ( 35 ) , Y ( 35 ) , Q ( 1 00 ) , P ( 1 00 ) , C ( 35 ) 

REAL*8 A ( 1 6 ) , ALPH (12),B(16),S(16),G(16),U(16) 
REAL*8 ARRAY1 ( 13) , ARRAY2( 12) 


C***** 

REAL*8 

1 


D, XMEA, YMEA, HUH, XMEAN, YMEAN, ERR, YSTDER, El , FI , 
W1 , W, V, SI , T, T3, T5, ROOT, Q7, POS, Q8, PCT 


,5H + F 


DATA ALPH/5H A , 5H + B , 5H + C , 5H + D , 5H + E 

*5H + G ,5H + H ,5H + I , 5H + J , 5H + K , 5H + L / 

DATA ARRAY 1 /5H , 5H X , 5H X**2,5H X**3,5H X**4,5H X**5, 

*5H X**6, 5H X* *7, 5H X*»8,5H X**9, 5HX** 10, 5HX** 1 1 , 5HX** 1 2/ 

DATA ARRAY2/5HFI RST, 6HSEC0ND, 5HTHI RD, 6HF0URTH, 5HFI FTH, 5HSI XTH, 
* 7HSEVENTH, 6HEI GHTH, 5HN1 NTH, 5HTENTH , 8HELEVENTH , 7HTWELFTH/ 


D=DFLOAT (M) 
G ( 1 )=0.0 


N = N+1 

IF (N.GT. 12) GO TO 230 
IF (M.LT.N) GO TO 240 
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XMEA = 0 . 0 
YMEA=0 . 0 
HUH=0 

DO 10 I = 1 , M 
XMEA=XMEA+X( I ) 

YMEA = YMEA+Y( I ) 

10 HUH=HUH+Y ( I ) **2 
XMEAN=XMEA/D 
YMEAN=YMEA/D 

ERR= (D*HUH-YMEA**2)/(D**2-D) 

IF ( IP.EQ.O) GOTO 500 
YSTDER=DSQRT ( ERR ) 

WRITE (6,250) M 
WRITE (6,260) XMEAN, YMEAN 
WRITE (6,270) YSTDER 
500 DO 20 I = 1 , M 
P( I ) =0 . 0 
20 Q ( I ) = 1 , 0 

DO 30 1=1,11 
A ( I ) =0 . 0 
B( I ) =0 . 0 
30 SC I ) =0 . 0 
El =0 . 0 
FI =0. 0 
W1=D 
N4 =12 
1 = 1 

40 W=0.0 

DO 50 L= 1 , M 
50 W=W+Y(L)*Q(L) 

S( I >=W/W1 

IF ( I -N4.GE.0) GO TO 80 
IF ( I -M.GE. 0) GO TO 80 
El =0. 0 
DO 60 L= 1 , M 

60 El =E 1 +X (L)*Q(L)*Q(L) 

E1=E1/W1 
A ( 1+1 ) =E 1 
W=0. 0 

DO 70 L= 1 , M 

V=(X(L)-E1 )*Q(L)-F1*P(L) 

P ( L ) =Q( L ) 

QCL)=V 
70 W=W+V*V 
FI =W/W1 
B ( I +2) =F1 
W1=W 
1 = 1+1 
GO TO 40 
80 DO 90 L=3 , 12 
90 G ( L ) =0 . 0 
G( 2 ) = 1 . 0 
LL = 2 

DO 130 J= 1 , N 

S1=0.0 

DO 110 L= 1 , N 

IF ( L . EQ . 1 ) GO TO 100 

LL=L+ 1 

G( LL ) =G( LL ) -A ( L ) *G ( LL- 1 ) -B( L) *G( LL-2) 
100 SI =S1+S(L)*G(LL) 


110 CONTINUE 
U( J)=S1 
L = N+1 

DO 120 I 2 = 2, N 
G(L) =G(L-1 ) 

120 L = L- 1 
LL = 2 

130 G(2)=0. 0 
T=0 . 0 

DO 150 L= 1 , M 
C ( L ) =0 . 0 
J = N 

DO 140 I 2= 1 , N 
C(L)=C(L)*X(L)+U( J) 

140 J=J-1 

T3=Y(L) -C(L) 

150 T=T+T3**2 

IF (M.NE.N) GO TO 160 
T5=0. 0 
GO TO 170 

160 T5=T/(D-DFL0AT(N) ) 

ROOT = DSQRT ( T5 ) 

IF (IP.EQ.1) WRI TEC 6, 280) ROOT 
170 IF (DABS(ERR) . LT. 0. 00001 ) ERR = 0.001 
Q7 = 1 .O-T/CERRMD-1 .0) ) 

LESS=N- 1 

IF (IP.EQ.O) GOTO 501 
WRITE (6,290) LESS 
WRITE (6,300) Q7 
WRITE (6,310) 

DO 180 J=1 ,N 
l 2= J - 1 

180 WRITE (6,320) I 2, ALPH( J ) , U ( J ) 

N1 = N-1 

WRI TE ( 6 , 330 ) ARRAY2(N1 ) 

N1 = N 

WRI TE( 6, 340) ALPH( 1 ) , ALPH( 2) , ARRAY 1 (2) , (ALPH( I ) , ARRAY 1 ( I ) , I =3, N1 ) 
IF (N.LE.9) GOTO 191 

WRITE (6, 350) ( ALPH( I ) , ARRAY 1 (I ) , I = 1 0, N) 

191 WR I TE (6, 360 ) 

501 KOUNT = 0 

DO 220 L= 1 , M 
POS=DABS ( Y ( L ) -C(L) ) 

IF (POS.LT. 0. IE-08) Y(L)=C(L) 

Q8=Y (L)-C(L) 

IF (C(L) .EQ.O.O) GO TO 200 
POT = 1 00 . 0*Q8/C ( L ) 

IF (IP.EQ.1) WR I TE ( 6 , 370 ) X ( L ) , Y ( L ) , C( L) , 08, PCT 
GO TO 210 

200 IF (IP.EQ.1) WRI TE( 6, 380) X ( L) , Y ( L ) , C( L) , Q8 
210 KOUNT =KOUNT + 1 

IF (KOUNT. LT. 42) GO TO 220 
IF (IP.EQ.1) WRI TE( 6, 360) 

IF (KOUNT. EQ. 42) K0UNT=0 
220 CONTINUE 
N = N- 1 
RETURN 

230 WRITE (6,390) 

STOP 
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WRITE (6,400) LESS 
RETURN 


250 

FORMAT 

260 

FORMAT 

270 

FORMAT 

280 

FORMAT 

290 

FORMAT 

300 

FORMAT 

310 

FORMAT 

320 

FORMAT 

330 

FORMAT 

340 

FORMAT 

350 

FORMAT 

360 

FORMAT 

370 

FORMAT 

380 

FORMAT 

390 

FORMAT 

400 

FORMAT 


END 


( 1 H 1 , 6X , 1 8HNUMBER OF POINTS =,14) 

( 7X, 1 7HMEAN VALUE OF X =,F10.4 / 7X, 1 7HMEAN VALUE OF Y 
F10.4) 

( 7X, 21 HSTANDARD ERROR OF Y =,F10.4) 

(1H0, 6X, 35HSTANDARD ERROR OF ESTIMATE FOR Y =,F9.4 //) 

( 7X, 1 6H0E0REE OF FIT = ,12) 

(7X,23H INDEX OF DETERMINATE = ,F9.7 /) 

( 7X, 4HTERM, 4X, 6HLETTER, 1 OX, 1 1 HCOEFFI Cl ENT/ ) 

(8X, I 2, 6X, A3, 7X, E23 . 16) 

( 1 HO, 6X, 1 2HEQUAT1 ON IS ,A8,16H DEGREE POLYNOMIAL /) 

( 7X, 3HY =, 2A3.A1 , IX, 7<A3,A4, IX) ) 

(//IX, 3(3H + ,A2,A3//>) 

( 1 HI , 9X, 8HX- ACTUAL, 7X, 8HY- ACTUAL, 8X, 6HY-CALC, 5X, 

1 OHDI FFERENCE, 5X, 8HPCT-DI FF /) 

( 7X, FI 2 . 6, 3X, FI 2 . 6, 3X, FI 2 . 6, 3X, FI 0 . 6, 5X, F8 . 4 ) 

(7X, FI 2. 6, 3X, FI 2. 6, 3X, FI 2. 6, 3X, F10. 6, SX, 8HINFI Nl TE) 

( 1 X, 38HERR0R ELEVENTH DEGREE IS THE LIMIT) 

(IX, 44HERR0R TOO FEW POINTS FOR FITTING DEGREE, 13) 
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CPROGRAMME SOURCE N04BD 


MAIN PROGRAM (DRIVER) FOR PHASE 2 OF 
ACOUSTICS DATA ANALYSIS. 

LOGICAL UNIT ASSIGNMENTS - 


05 

06 
07 

9 

06 

10 

69 


USER PROGRAM INPUTS 
OUTPUT (LINE PRINTER) FILE 

BINARY DUMP FROM PHASE 1 ANALYSIS (SAVED IN DISK FILE) 
ECRITURE SUR RNOISE DE PS I VAL-XDVAL 
CORRECTION DATA 

NEAR FIELD SPL READINGS AND MIKE ANGLES 

TRACES : MESURES-P0LYN0MES-D1 RECTI VI TE CHAMP LOINTAIN 


REAL*8 DUMP, DUMP1 , DUMP2, DUMP3 

REAL* 6 PRESS, RTOK, FTOM, TEMPK , ABDBM , D I STME 

REAL *8 VJ, FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDIA 

REAL*8 PS I S, XDN, PS 11 , FFSPL, ST , STP, PSI 2, VAMB, VJET, SDHUM, SDTEMP, 

*COFNr] AN^YY^RSD^D^r! XDI S^ L ^ S< D ^ C ^' ^TSRCE, HTMI KE, PS I VAL, XDVAL , 

COMMON /SUB1 / VJ, FREQ ( 33 ), THETAS ( 50 , 33 ), XOVERD ( 50, 33 ) 

* NTAB ( 33 ) , NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , 

* NZTYPE( 10), NFREQ 


COMMON /SUB2/ 


1 

3 

4 

5 

6 

7 

8 


PS I S ( 50, 35 ) , XDN ( 50, 35) , PSI 1 (50, 35) , PS I 2 ( 50, 35 ) , 
FFSPL ( 50, 35) , ST( 35) , STP<35) , 

IWT1 , IWT2, VAMB, VJET, KFIT( 2), SDHUM, 

SDTEMP , TTEMP , THUM , PS I LO , PS I HI , M I KEA , I B I DON , 
ANGLES (70) , DECB2(70, 35) , HTSRCE, HTMI KE( 70) , 

PS I VAL ( 50 ) , XDVAL ( 50 , 35 ) , COFNR C 1 1 , 35 ) , AN, Y Y , 

R2D, D2R, XD I S ( 70, 2 ) , IMRC, IBNC, IRC, IAAC, 

I PFRQC, I PANGL, I CALL, NTYPE 


COMMON/TST / I TEST ( 70, 30 ) , NOFR ( 30 ) 

COMMON/TRAFLG/KTRAC, KTFFSPL, KTDECBM, KTDECBP 

COMMON/ I DENT/NPO I , KM I C, NPOI F, KLIG, 1GLDEB, IGLFIN 

COMMON/ T I TRE/LI B( 1 0) , I DATE(3) , DB1 (8,4), I PI ( 8) , LI B1 ( 20 ) , L I B2 ( 20 ) 

DIMENSION I T I T ( 20 ) , XMOD( 44 ) ‘ 

DIMENSION DUMP ( 3446 ), DUMP1 ( 74 ) , DUMP2( 1 800) , DUMP3M 32) LIBID 
*( 10), IDATBID(3) ' 

EQUIVALENCE (DUMP(1),VJ) 

EQUIVALENCE ( DUMP1 ( 1 ) , ST ( 1 ) ) 

EQU I VALENCE ( DUMP2 ( 1 ) , PS I VAL ( 1 ) ) 


DATA PRESS, RTOK, FTOM, D2R /1.0, 0.55555556, 
C*****CODE DE TRA I TEMENT 
C KODT 0 TRA I TEMENT BANDE MODANE 

C KODT 1 TRA I TEMENT DONNEES AMES 

C KODT 2 TRA I TEMENT DONNEES AMES BANDES 

READ (5, 101 )KODT 
101 FORMAT (15) 

C*****MISE A ZERO DU TABLEAU DECB2 
DO 10 1=1,70 
DO 10 J = 1 , 30 
10 DECB2 ( I , J ) =0. 


0.3048, 


0.017453293/ 
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R2D 


1 . 0/D2R 


READ UNFORMATTED DATA FROM PHASE 1 PROGRAM 
NW=7 

READ ( NW, END =92 ) DUMP 
READ C NW . END = 92 ) DUMP3 
READCNW, END=92) NBI D 
READCNW, END=92)LI Bl D 
READCNW, END=92) I DATBI D 
READCNW, END=92 ) L I Bl 
READCNW, END=92 ) L I B2 
GO TO 100 

92 WRITE (6, 91 ) ; STOP 

91 FORMAT ( 1 HI , 64HE0F ENCOUNTERED WHILE READING DATA FROM PHASE 1, LO 
*G I CAL UNIT 07 /) 


100 CALL READ I N ( L I ST , KPF , KODT , I T I T ) 

I F C KPF . EQ . 0 ) GO TO 300 

CALL STEST ( M I KEA , NFREO , ANGLES , FREQ ) 

300 CONTINUE 

***** PREPARATION DU TRACE 

IFCKTRAC. EQ. 0) GO TO 150 
DO 160 1=1,44 
XMODC I ) =0 . 

160 CONTINUE 
KPLANC=0 

CALL OPENTR ( 69 , XMOD ) 

150 CONTINUE 

CALL 0SPL(DECB2,MIKEA, NFREQ) 

CALL SUBPDB CM I KEA, DECB2, NFREQ) 

WRITEC6, 1001 ) 

1001 FORMAT ( 1 HI , 30X, 55HS0UND PRESSURE LEVELS READ AS INPUTS FOR THIS EX 
*ECUT I ON /) 

CALL OUTPUT C XD I S, DECB2, ANGLES, FREQ, MI KEA, NFREQ, HTM I KE ) 

IFCLIST.EQ. 1 ) GO TO 201 

IF ( IMRC.NE. 1 ) GOTO 40 
I CALL = 1 
CALL CORECT 

40 IF (IBNC.NE.1) GOTO 50 
I CALL = 2 
CALL CORECT 

50 IF (IRC . NE . 1 ) GOTO 60 
I CALL = 3 

60 IF (IAAC.NE.1) GOTO 80 


ATMOSPHERIC ABSORBT I ON CORRECTIONS 
PRESS = ATMOSPHERES 

RTOK = RANKIN TO KELVIN CONV FACTOR 
FTOM = FEET TO METERS CONV FACTOR 

TEMPK = TTEMP*RTOK 
DO 200 NF=1, NFREQ 

CALL A I FAB ( PRESS, TEMPK, THUM , FREQ ( NF ) , ABDBM ) 
DO 220 M I C= 1 , Ml KEA 
DISTME = XD I S ( M I C , 2 ) *FTOM 
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DECB2(MI C, NF) = DECB2( M I C, NF ) + ABDBM#DI STME 
220 CONTINUE 
200 CONTINUE 
C 

00 IFC IMRC.EQ.O. AND. I BNC . EQ . 0 . AND . I RC . EQ . 0 . AND . I AAC . EQ . 0) GOTO 90 
CALL OSPL (DECB2, MI KEA, NFREQ) 

CALL SUBPDB ( M I KEA , DECB2 , NFREQ ) 

WR I TE ( 6 , 1002) 

1002 FORMAT ( 1 HI , 30X, 22HDATA AFTER CORRECTIONS /) 

CALL OUTPUT ( XD I S , DECB2, ANGLES, FREQ, MI KEA, NFREQ, HTMI KE ) 

C 

90 CONTINUE 
CALL THMERG 
CALL C0MP2 
CALL NEWPSI 

C# * * * * 

TRACE DES MESURES 
I F ( KTDECBM . EQ . 0 ) GO TO 190 
NCAR= 1 7 

CALL TDECB1 ( KPLANC, DECB2, ANGLES, FREQ, NFREQ, MI KEA, 

1 'FIG. MESURES. ' ,NCAR,XMOD) 

190 CONTINUE 

CALL CURVFT 

C***** TRACE DES POLYNOMES D INTERPOLATION 
I F ( KTDECBP . EQ . 0 ) GO TO 180 
NCAR=35 

CALL TDECB1 (KPLANC, DECB2, ANGLES, FREQ, NFREQ, MIKEA, 

1 'FIG. POLYNOMES D INTERPOLATION. ',NCAR,XMOD) 

180 CONTINUE 
C 

WRITEC6, 1003) 

1003 FORMAT ( 1 HI , 30X, 20HDATA AFTER SMOOTHING / ) 

CALL OUTPUTCXDIS, DECB2, ANGLES, FREQ,MIKEA, NFREQ, HTMIKE ) 

CALL 0SPLCDECB2, MIKEA, NFREQ ) 

CALL SUBPDB (Ml KEA, DECB2, NFREQ) 


r»A| I 

* * * * TRACE DU CHAMP L0INTAIN 
I F (KTFFSPL . EQ . 0 )G0 TO 170 
NCAR=25 
M I KEA=50 

CALL 0SPL1 (FFSPL, MIKEA, NFREQ) 

CALL TDECB2( KPLANC, FFSPL, PS I 2, PS I VAL, FREQ, NFREQ, MI KEA, YY, 
* 'FIG. CHAMP LOINTAIN. ',NCAR,XMOD) 

170 CONTINUE 


ECRITURE SUR DISQUE (TRACE PSI-X2 ECH NASA) 
WR I TE ( 9 ) DUMP1 
WR I TE ( 9 ) DUMP2 
WR I TE ( 9 ) NPO I 
WR I TE ( 9 ) L I B 
WRI TE ( 9 ) IDATE 
REWIND 9 
C 

C***** FIN DE TRACE 

IF(KTRAC.EQ.O) STOP 
CALL CLOSTR ( XMOD ) 
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WRITE (6, 1004) KPLANC 

1004 F0RMAT(1H1///3X, 1 MOMBRE DE PLANCHES= ' , 13////) 
CM**** 

201 CONTINUE 
STOP 
END 

• DECK A I FAB 

SUBROUTINE A I FAB (P, T, RH, CF, ABDBM) 


THIS PROGRAM CALCULATES THE ABSORBT 1 ON OF SOUND IN AIR AS A 
FUNCTION OF TEMPERATURE, HUMIDITY, PRESSURE AND FREQUENCY. 

THE PROGRAM SHOULD NOT BE USED FOR CALCULATIONS OUTSIDE 

THE TEMPERATURE RANGE OF 0 DEG F C -20 DEG C) THROUGH 104 DEG F 

(40 DEG C) 

ABDBM = AMPLITUDE ABSORBT I ON COEFFICIENT IN DB/METER 
ABDBSC = AMPLITUDE ABSORBT I ON COEFFICIENT IN DB/SECONDS 
ABDBTF = AMPLITUDE ABSORBT I ON COEFFICIENT IN DB/1000FT 
ABDAM = AMPLITUDE ABSORBT I ON COEFFICIENT PER WAVELENGTH 
ALPHA = AMPLITUDE ABSORBT I ON COEFFICIENT IN NEPERS PER METER 

CF = ACOUSTIC FREQUENCY 
P = AMBIENT PRESSURE IN ATM 

PS = SATURATED VAPOR PRESSURE FOR WATER IN ATMOSPHERES 

T = TEMPERATURE IN DEGREES KELVIN 

TC = TEMPERATURE IN DEGREES CENTIGRADE 

TF = TEMPERATURE IN DEGREES FAHRENHEIT 

WAVEL = WAVELENGTH OF SOUND WAVE 


REAL*8 ABDBM, CF,P,RH,T 

REAL* 8 PI , T1 , TC, TF, VEL, VELFPS, T01 , PS, H, FR02, FRN2, ALPHA, WAVEL, 

* ABDAM, ABDBTF, ABDBSC 
PI = 3. 14159 
T1 = T/293 . 

TC = T-273. 

TF = TC* 1 . 8+32. 

VEL = 343 . 4*DSQRT ( T 1 ) 

VELFPS = VEL*3 . 28 
T01 = 273.16 

PS = 10. 79586* ( 1 . -T01 /T) -5. 02808*DL0G10(T/T01 ) +1 . 50474E-4* ( 1 . - 1 0. - 

C**( -8. 29692* ( ( T/T01 ) -1 . ) ) ) +0 . 42873E-3* ( 1 0 . **(4.76955* 

C ( 1 . -(T01/T) ) ) -1 . ) -2. 2195983 
PS = 1 0 . **PS 
H = PS/P*RH 

FR02 = P* ( 24 . +4 . 41 E04*H* (0. 05+H) / (0 . 391 +H) ) 

FRN2 = P/DSQRT ( T 1 ) * ( 9 . +350 . *H*DEXP (-6. 1 42* < ( 1 ./T1 )**. 331 - 1 . ) ) ) 

ALPHA = 1 . 84E-1 1 +2. 1 913E-4/T1 *P*(2239. 1 /T) * *2*DEXP ( -2239. 1 /T) 

C / ( FR02+ ( CF* *2/FR02 ) ) 

ALPHA = ALPHA+8. 1 61 9E-4/T1 *P* ( 3352 . /T ) **2*DEXP( -3352 . /T ) 

C / ( FRN2+ ( CF* *2/FRN2 ) ) 

ALPHA = ALPHA*DSQRT(T1 )*CF**2/P 
WAVEL = VEL/CF 
ABDAM = ALPHA*WAVEL 
ABDBTF = ALPHA*2647 . 

ABDBM = ALPHA*8 . 6860 
ABDBSC = ALPHA*VEL*8. 686 
CONTINUE 


cj - 2— 


97 


ooooooooooooooooooo 


RETURN 

END 

*DECK ATMAT 

SUBROUTINE ATMAT ( T, RH, DIST, FREQ, ATT) 


ATMAT STANDS FOR ATMOSPHERIC ATTENUATION 

COMPUTES EXCESS ATMOSPHERIC ATTENUATION IN DECIBELS FOR GIVEN 
TEMPERATURE, RELATIVE HUMIDITY, DISTANCE, AND FREQUENCY. 

USES EMPIRICAL CURVE FITS OF DATA CONTAINED IN SOCIETY OF 
AUTOMOTIVE ENGINEERS AEROSPACE RECOMMENDED PRACTICE NO. 266, 
AUGUST, 1964 

T TEMPERATURE (DEGREES FAHRENHEIT) 

RH RELATIVE HUMIDITY 

DIST DISTANCE (FEET) 

FREQ FREQUENCY ( HERTZ ) 

ATT ATTENUATION (DECIBELS) 


REAL*8 ATT, DIST, FREQ, RH, T 

REAL* 8 A, AC, AMM, HA, HMM, HH, AA, HTEST 

DIMENSION A( 22) 

DATA A/O . 870, 0 . 750, 0 . 652, 0 . 570, 0 . 505, 0 . 452, 0 . 406, 0 . 369, 0 . 335, 

10.308.0. 286.0.268.0.253.0.240.0.231.0.225.0.220.0.215.0.210, 

20.208.0. 202.0.200/ 

AC = (0. 1MFREQ/1 000.0) **2.05) /(I . 651 - . 001 03*T ) * *2 . 05 
AMM = ( 1 0 . 0* ( FREQ/ 1 000 .0)**1.003)/10.0**(0.52-. 00504 * ( T + 

1 DSQRT ( 256 . 0 - ( 1 0 . O-T/5 . 0 ) **2) ) ) 

HA = 0.25 * RH/1 0, 0** ( 1 . 493- . 01 638*T- . 02*DSQRT( 1 28. 2 - 
1(10. O-T/5. 00)**2)) 

HMM = 1 0 . 0** ( 0 . 4973*DL0G1 0( FREQ) - 1 . 4894 ) 

HH = HA / HMM 
IF(HH.GT. 0. 25) GO TO 1 
AA a 1,2 * HH 
GO TO 8 

1 IF(HH.GT. 0. 60) GO TO 2 
AA = 1 . 543 * HH - . 086 
GO TO 8 

2 I F ( HH . GT . 0 . 95) GO TO 3 

AA = 0.84 + 0.16 * DSIN(3. 14159/2. 0*(HH-0. 6) / 0.35) 

GO TO 8 

3 I F( HH . GT . 1 .25) GO TO 4 

AA s 0,87 + 0,13 * DC0S(3. 14159/2. 0*(HH-0. 95) / 0.3) 

GO TO 8 

4 I F ( HH . GT .6.5) GO TO 7 
HTEST =1.25 

DO 5 I =2,22 

HTEST = HTEST +0.25 

I F( HH. LE. HTEST) GO TO 6 

5 CONTINUE 

6 AA = AC I ) + ( ( HTEST-HH ) / 0.25) * ( A ( I - 1 ) -A( I ) ) 

GO TO 8 

7 AA = 0.2 

8 CONTINUE 

ATT = ( AMM*AA+AC) * ( Dl ST*0, 001 ) 
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RETURN 

END 

•DECK C0MP2 

SUBROUTINE C0MP2 
C 

REAL* 8 C, TRMj FI , VDI F, F2, TH1 , TH2, D 

REAL*8 VJ, FREQ, THETAS , XOVERD, XDMAX, THETSM, RNZDI A 

REAL*8 PS I S , XDN, PS I 1 , FFSPL, ST , STP, PSI 2, VAMB, VJET , SDHUM, SDTEMP, 

* TTEMP , THUM , PS 1 LO , PS I H I , ANGLES , DECB2 , HTSRCE , HTM I KE , PS I VAL , XDVAL , 
*COFNR, AN, YY , R2D, D2R, XDI S 

COMMON /SUB1 / VJ, FREQ ( 33 ) , THETAS ( 50, 33 ) , XOVERD ( 50 , 33 ) , 

* NTAB ( 33 ) , NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , 

* NZTYPE MO), NFREQ 
C 

COMMON /SUB2/ PS I S ( 50, 35 ) , XDN ( 50 , 35 ) , PS I 1 ( 50, 35) , PS I 2 ( 50 , 35 ) , 

1 FFSPL ( 50, 35 ) , ST ( 35 ) , STP ( 35) , 

3 I WT 1 , IWT2, VAMB, VJET, KFIT(2), SDHUM, 

4 SDTEMP, TTEMP, THUM, PSI LO, PSI HI .MIKEA, IBI DON, 

5 ANGLES (70) , DECB2(70, 35) , HTSRCE, HTM I KE ( 70 ) , 

6 PSI VAL (50) , XDVAL (50, 35) , COFNR( 1 1 , 35 ) , AN, YY , 

7 R2D.D2R, XD I S ( 70, 2) , I MRC, I BNC, I RC, I AAC, 

8 I PFRQC, I PANGL, I CALL, NTYPE 


DATA STATEMENT DEFINES ACOUSTIC VELOCITY, C IN FEET PER SEC 
DATA C /I 1 15.0/ 

TRM = VAMB/C 

FI = RNZDI A/VJET 

VDI F = VJET - VAMB 

IF ( VDIF .EQ. 0.0 ) VDIF = VJET 

F2 = RNZD I A/ VDIF 

DO 1000 1=1, NFREQ 

ST ( I ) = FREQ( I ) * FI 
STP ( I ) = FREQ( I ) * F2 

NJ = NTAB(I) 

IF (NJ.EQ.O) GO TO 1000 

TRANSFORM EACH THETA-S TO PSI-S FOR THIS FREQUENCY 
DO 500 J = 1 , NJ 

TH1 = DS I N ( D2R * ( THETAS ( J , I ) - 90.) ) + TRM 
TH2 = DCOS ( D2R * ( THETAS (J, I) - 90.) ) 

IF ( TH1 . EQ .0.0 .OR. TH2 .EQ. 0.0 ) GO TO 450 
PSIS(J,I) = DATAN(TH1 /TH2) *R2D + 90. 

GO TO 500 
450 CONTINUE 

PS I S ( J , I ) = 0.0 
500 CONTINUE 

FOR EACH NEW PS IS OF THIS FREQUENCY, CONVERT XI TO X2 
( XOVERD TO XDN) FOR EACH NEW PS IS VALUE 

D = 0.0 
DO 600 J=1 , NJ 

IF ( PS I S ( J , I ) . EQ . 0 . 0) GOTO 650 

CALL TAINT ( THETAS (1,1), XOVERD ( 1 , I ) , PS I S ( J , I ) , XDN ( J , I ) , N J , 3 , NER , D ) 
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IF (NER. NE. 1 ) GOTO 650 
GOTO 600 

650 XDN( J, I ) = 0. 0 
600 CONTINUE 
C 

1000 CONTINUE 
C 

RETURN 

END 

*DECK CORECT 

SUBROUTINE CORECT 

I CALL = 1 FOR MIKE RESPONSE CORRECTIONS 
I CALL = 2 FOR REVERBERATION CORRECTIONS 
I CALL = 3 FOR BACKGROUND NOISE CORRECTIONS 


REAL#8 CORVAL, DUMMY 1 , DUMMV2 

REAL*8 VJ, FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDI A 

REALMS PSI S, XDN, PSI 1 , FFSPL, ST, STP, PSI 2, VAMB, VJET, SDHUM, SDTEMP , 

* TTEMP , THUM , PS I LO , PS I H I , ANGLES , DECB2, HTSRCE , HTM I KE , PS I VAL , XDVAL , 
*COFNR, AN, YY , R2D , D2R , XDI S 

COMMON /SUB1 / VJ, FREQ ( 33 ), THETAS ( 50, 33 ), XOVERD ( 50, 33 ) , 

* NTAB ( 33 ) , NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RN2D I A , 

* NZTYPE (10), NFREQ 

COMMON /SUB2/ PS I S ( 50 , 35 ) , XDN ( 50 , 35 ) , PS I 1 ( 50, 35 ) , PS I 2 ( 50, 35 ) , 

1 FFSPL (50, 35) , ST (35) , STP (35) , 

3 IWT1 , I WT2, VAMB, VJET , KF I T( 2) , SDHUM, 

4 SDTEMP, TTEMP, THUM, PSI LO, PSI HI , MI KEA, IBIDON, 

5 ANGLES ( 70 ) , DECB2 (70,35), HTSRCE , HTM l KE ( 70 ) , 

6 PS I VAL ( 50 ) , XDVAL (50,35), COFNR ( 11 , 35 ) , AN , Y Y , 

7 R2D, D2R, XDI S( 70, 2), IMRC, IBNC, IRC, IAAC, 

8 I PFRQC, I PANGL, I CALL, NTYPE 

DIMENSION CORR ( 50, 33) 

EQU I VALENCE ( CORR (1,1), XOVERD (1,1)) 

EQUIVALENCE STATEMENT TO SAVE CORE SPACE 

MIKEB = 0 

INITIALIZE ARRAY OF CORRECTION VALUES 

DO 100 J=1 , 33 
DO 100 K= 1 , 50 
100 CORR ( K , J) = 0.0 

REWIND 8 

GOTO (200,400,600), I CALL 


THIS SECTION IS USED FOR MIKE RESPONSE CORRECTIONS 


200 READ (8) I RUN, I CHAN , I BAND, CORVAL, DUMMY 1 , DUMMY2 
IF ( I RUN. EQ. 0. AND. I CHAN. EQ. 0) GOTO 300 
IF ( I CHAN. LT. 1 . OR. I CHAN. GT. 50) GOTO 200 
IF ( I BAND. LT. 1 . OR. IBAND.GT. NFREQ) GOTO 200 
CORR ( I CHAN, I BAND) = CORVAL 


100 
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GOTO 200 
300 WRITE(6,801 ) 

SOI FORMAT ( 1 HI , 1 OX, 31 HMI KE RESPONSE CORRECTION VALUES /) 
CALL OUTCOR ( CORR , M I KEA , M I KEB , NFREQ ) 

APPLY CORRECTIONS 

250 DO 225 J=1, NFREQ 
DO 225 K= 1 , MI KEA 

225 DECB2(K, J ) = DECB2 ( K , J ) -CORR ( K, J ) 

GOTO 900 


THIS SECTION APPLIES REVERBERATION CORRECTIONS 


400 READ (8) I RUN, I CHAN, I BAND, DUMMY 1 , CORVAL, DUMMY2 
IF ( I RUN. EQ. 0. AND. I CHAN. EQ. 0) GOTO 500 
IF ( ICHAN.LT. 1 .OR. I CHAN. GT. 50) GOTO 400 
IF ( IBAND.LT. 1 .OR. I BAND. GT. NFREQ) GOTO 400 
CORR (I CHAN, I BAND) = CORVAL 
GOTO 400 

500 WR I TE (6, 802 ) „„ 

802 FORMAT (1 HI , 1 OX, 3 1 HREVERBERAT I ON CORRECTION VALUES /) 
CALL OUTCOR ( CORR , M I KEA , M I KEB , NFREQ ) 

GOTO 250 


APPLY BACKGOUND NOISE CORRECTIONS HERE 


600 READ (8) I RUN, I CHAN, I BAND, DUMMY 1 , DUMMY2, CORVAL 
IF ( I RUN . EQ . 0 . AND . I CHAM . EQ . 0 ) GOTO 700 
IF ( I CHAN. LT. 1 . OR. I CHAN. GT. 50) GOTO 600 
IF ( I BAND. LT. 1 . OR. I BAND. GT. NFREQ) GOTO 600 
CORR ( I CHAN, I BAND) = CORVAL 
GOTO 600 

700 WRITE (6,803) 

803 FORMAT ( 1 HI , 1 OX, 34HBACKGR0UND NOISE CORRECTION VALUES /) 
CALL OUTCOR (CORR, MI KEA, MI KEB, NFREQ) 

GOTO 250 

SUBROUTINE EXIT 


900 RETURN 
END 

*DECK CURVFT 

SUBROUTINE CURVFT 


C 


REAL*8 TEMP, XCNT, COEF, YNEW, TOL, PCT , FJ 

REAL*8 VJ, FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDI A 

REAL*8 PS I S , XDN, PS I 1 , FFSPL, ST, STP, PSI 2, VAMB, VJET, SDHUM, SDTEMP, 
*TTEMP, THUM, PSI LO, PSI HI , ANGLES, DECB2, HTSRCE, HTMIKE, PSI VAL, XDVAL, 


*COFNR, AN, YY, R2D, D2R, XDI S 

COMMON /SUB1/ VJ, FREQ ( 33 ), THETAS ( 50, 33 ), XOVERD ( oO, 33 ) , 

* NTAB ( 33 ) , NTEST, XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , 

* NZTYPE( 10), NFREQ 
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c 


COMMON /SUB2/ PS I S ( 50, 35 ) , XDN ( 50, 35 ) , PS I 1 (50, 35) , PS l 2(50, 35) , 
1 FFSPL ( 50, 35 ) , ST ( 35 ) , STP ( 35 ) , 

3 IWT1 , 1 WT2, VAMB, VJET, KFI T(2) , SDHUM, 

4 SDTEMP, TTEMP, THUM, PSI LO, PSI H! , MIKEA, IBIDON, 

5 ANGLES < 70 > , DECB2 (70,35), HTSRCE , HTM I KE ( 70 ) , 

6 PS I VAL ( 50 ) , XDVAL ( 50, 35) , COFNRt 1 1 , 35 ) , AN, YY , 

7 R2D, D2R, XDIS(70,2) , IMRC, IBNC, IRC, IAAC, 

8 IPFRQC, IPANGL, I CALL, NTYPE 

D I MENS I ON TEMP ( 65 ) , XCNT ( 65 ) , COEF (11), YNEW ( 65 ) 

DATA TOL /6 . 0/ 

I PR I NT = 0 


FIRST CURVE FIT (SMOOTH DATA) FOR EACH ANGLE ACROSS 
BAND NO. VS SPL. USE THE WIEGHTING PARAMS ENTERED BY 
THE USER. DO NOT SAVE THE COEFFICIENTS FOR THIS PASS. 


IF (IWT1.EQ.0) I WT1 =NFREQ 
DO 200 MIC = 1 , MI KEA 

DO 100 K= 1 , I WT1 
XCNT(K) = DFLOAT(K) 

100 TEMP(K) = DECB2 (M I C , K ) 

NEXT = I WT 1+1 
LAST = I WT2 
KNT = I WT1 

IF ( IWT1 . EG. NFREQ) GOTO 108 

DO 102 K= NEXT, LAST 
DO 103 L= 1 , 2 
KNT = KNT+1 

XCNT ( KNT ) = DFLOAT ( KNT ) 

TEMP ( KNT ) = DECB2CMI C, K) 

103 CONTINUE 
102 CONTINUE 

DO 104 K= I WT2, NFREQ 
KNT = KNT+1 

XCNT (KNT) = DFLOAT (KNT) 

TEMP (KNT ) = DECB2(MI C , K ) 

104 CONTINUE 


108 IF ( IPFRQC. GT. 0) IPRINT=1 

CALL POLFIT ( XCNT, TEMP, KNT, KF I T ( 1 ) , COEF, YNEW, I PR I NT ) 


DELETE BAD PTS (.GT.TOL) .. BUT NOT MORE THAN 1/5-TH OF THEM 
MOVE ARRAY CONTENTS UP AND REFIT DATA 

MINPTS = KNT-CKNT/5) 

MSUB = KNT-MINPTS 
MCNT = 0 
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c 

DO 44 I J = 1 , KNT 

PCT = ( (TEMPI I J ) -YNEW( I J) ) /YNEW( I J ) ) *100. 0 
IF (DABSIPCT) .LT.TOL) GOTO 44 
IF (MCNT . GT . MSUB) GOTO 44 
TEMPI l J) =0.0 
44 CONTINUE 
C 

LAST = KNT 
K = 0 

220 K = K+1 

IF (K . GT . LAST) GOTO 225 
IF (TEMP(K) .NE.O.O) GOTO 220 
LAST = LAST-1 


C 


DO 230 KK = K, LAST 
TEMP(KK) = TEMPIKK+1) 

230 XCNT(KK) = XCNTIKK+1 ) 

TEMPI LAST+1) = 0. 

XCNTILAST+1 ) = 0. 

GOTO 220 
225 I PRI NT=0 

IF ( IPFRQC.EQ.2) IPR1NT=1 
CALL POLFIT ( XCNT , TEMP , LAST , 


KFI T ( 1 ) , COEF, YNEW, IPRINT) 


DO 120 J = 1 , NFREQ 
FJ = DFLOAT(J) 

120 0ECB2IM I C, J ) = POLYXICOEF, KFI T(1) , FJ) 
200 CONTINUE 


NOW CURVE FIT ANGLES VS DECIBELS FOR EACH FREQUENCY 
AND SAVE THE KFIT(2)+1 COEFFICIENTS IN ARRAY COFNR FOR 
EACH CURVE FIT PERFORMED 


IPRINT = 0 

IF ( IPANGL.NE.O) IPR!NT=1 
DO 390 K= 1 , MIKEA 
390 XCNTIK) = ANGLES! K) 

C 

DO 400 NF = 1 , NFREQ 

CALL POLFIT C XCNT , DECB2 ( 1 , NF ) , MI KEA , KF I T I 2) , COFNRI 1 , NF ) , 
» YNEW, IPRINT) 


DO 450 K= 1 , MIKEA 
450 DECB2IK, NF) = YNEW(K) 
400 CONTINUE 
C 

RETURN 

END 

«DECK NEWPSI 

SUBROUTINE NEWPSI 


C 


REAL *8 
REAL*8 
REAL*8 


’SI I NC, FN, DMON 

t J J FREQ , THETAS , XOVERD , XDMAX , THETSM, RNZD I A 

’SIS, XDN, PSI 1 , FFSPL , ST , STP , PS I 2 , VAMB , V JET , SDHUM , SDTEMP , 
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*TTEMF\ THUM, PSI LO, PSI HI , ANGLES, DECB2, HTSRCE, HTMIKE, PSI VAL, XDVAL, 
*C0FNR,AN,YY,R2D,D2R,XDIS 

COMMON /SUB1 / VJ, FREQ ( 33 ) , THETAS (50, 33) , XOVERD( SO, 33) , 

* NTAB ( 33 ) , NTEST , XDMAX ( 33 > , THETSM ( 33 ) , RN2D I A , 

* NZTYPE (10), NFREQ 

COMMON /SUB2/ PS I S ( 50, 35 > , XDN( 50, 35 ) , PSI 1 ( 50, 35 ) , PS I 2 ( 50, 35 ) , 

1 FFSPL (50, 35) , ST ( 35 ) , STP( 35 ) , 

3 IWT1, I WT2, VAMB, V JET, KF I T( 2) , SDHUM, 

4 SDTEMP, TTEMP, THUM, PSI LO, PSI HI , MI KEA, 1BID0N, 

5 ANGLES ( 70 ) , DECB2 (70,35), HTSRCE , HTM I KE ( 70 ) , 

6 PS I VAL ( 50 ) , XDVAL ( 50, 35 ) , COFNR ( 1 1 , 35 ) , AN , Y Y , 

7 R2D, D2R, XD I S ( 70, 2 ) , I MRC, I BNC, I RC, I AAC, 

8 I PFRQC , I PANGL , I CALL , NTYPE 
C 

K = 3 

PS I INC = (PS! HI -PSIL0)/50. 0 
C 

PS I VAL ( 1 ) = PSILO 
KNT = 2 
FN = 1.0 
C 

120 PS I VAL ( KMT ) = FN*PSI I NC+PSI LO 
KNT = KNT+1 

IF (KNT. GT. 50) GOTO 100 
FN = FN+1 . 0 
GOTO 120 
C 
C 

100 DO 200 I COL = 1 , NFREQ 
DMO N = 0.0 
I CNT = NTAB (I COL) 

IF (ICNT.EQ.O) GOTO 200 
C 

DO 300 I ROW = 1,50 

CALL TAINT ( PS I S ( 1 , I COL ) , XDN ( 1 , I COL ) , PSI VAL( I ROW) , 

* XDVAL ( I ROW, I COL) , I CNT, K, NER, DMON) 

IF (NER.EQ.1) GOTO 300 
XDVAL ( I ROW, I COL) =0.0 
300 CONTINUE 
C 

200 CONTINUE 
C 

c 

RETURN 

END 

*DECK NFCORR 
C 

SUBROUTINE NFCORR ( NTYPE, SLD, R, F, DV, DELDB ) 

C 

C 

C SUBROUTINE NFCORR IS USED TO COMPUTE NEAR FIELD CORRECTION VALUES FOR 

C PHASE 2 EXTRAPOLATIONS TO THE FAR FIELD. 

C THE CORRECTION VALUES ARE COMPUTED FROM TABLE INTERPOLATIONS USING 

C SUBROUTINE TAINT. 

C FOUR TABLES OF VALUES ARE PROVIDED , ONE FOR EACH NOZZLE TYPE AND 

C SIDELINE DISTANCE. 

C IF Y VALUES ARE TO BE EXTRAPOLATED , THEY (XOUT) WILL BE SET TO 0.0 

C 

C NTYPE = 1 FOR VFE NOZZLE 

C NTYPE = 2 FOR STOVEPIPE NOZZLE 
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NTYPE = 3 
NTYPE = 4 


FOR 1 04 TUBE NOZZLE 

FOR 104 TUBE NOZZLE WITH SHROUD NOZZLE 


THE VALUES 0..1.3 OR 1.19 WI 
DEPENDING ON THE SLD VALUE . 
IF THE SLD IS NOT WITHIN 10 
BE SET EQUAL TO 0 . 0 


LL BE SUBTRACTED FROM THE I NTERPOLATED DELDB , 
PERCENT OF 4 . 86 , 4 . 49 , 8 . 5 OR 7.86 j DELDB WILL 


C 


C 


C 


C 


c 

c 


c 


REAL* 8 SUBTR , SLD4, SLD1 , DIF1 , DIF2, PERC t , PERC2 , A , SUB , XOUT , X I N , D 
REAL *8 XI ,X,X2,X3,X4 
REAL*8 Y1 , Y , Y2, Y3, Y 4 

COMMON/ TBX/X1 ( 25 ) , X2 ( 25 ) , X3 ( 25 ) , X4 ( 25 ) 

COMMON/ TBY/Y1 ( 25 ) , Y2 ( 25 ) , Y3 ( 25 ) , Y4 ( 25 ) 

DIMENSION X( 25, 4 ) , Y ( 25, 4 ) 

DIMENSION SUBTR ( 4 ) , SLD4 ( 4 ) , KT AB ( 4 ) , SLD 1 (4) 

EQUIVALENCE ( X(1,1) , XI ( 1 ) ) , ( Y ( 1 , 1 ) , Y 1 ( 1 ) ) 

DATA XIZ.3,.4,.5,.6,.7, .8, .9,1.,1.5,1.9,2.,3.,4.,5.,7.,9.,11.,12., 

DATA Y 1 /2*0 . , . 0001 9, 3. 15,4, 65 ,2*4. 9, 4. 1,3. 75 ,3. 65 ,2. 65,2. 05, 

2 1 .45, . 8, . 25, 9*0. 0/ e ■» 

DATA X2/ .4,.5, .6, .7,-8, .9,1. ,1*4, 1.5, 1.6, 1.9, 2. ,3. ,4. ,5. ,6., 7., 

o 10 16. 20. .5*0.0/ 

DATA Y2/2*o! , . 08, 1 . 05, 2 . 38 , 3 . 68 , 4 . 1 , 4 . 58 , 4 . 68, 4 . 65, 4 . 58 , 4 . 48 , 3 . 8, 

2 3. 12,2.83,2. 12, 1 .75, .7, 7*0.0/ 

DATA X3/. 4, .5, .6, .7, .8, .9,1. ,1.4,1. 6, 1.8.2. .3. ,3. 5. 4. ,5. .6. ,7. ,8., 
2 1 0. , 14 . , 20. , 29. , 50. , 2*0. 0/ 

DATA Y3/2*0 . , . 5, 1 . 28, 1 . 88 , 2. 3, 2. 75, 3. 3, 3 . 5, 3 . 8, 3 . 8, 4 . 1 5, 4 . 2 , 4 1 5, 

2 4. 03, 3. 9,3. 66, 3. 48, 2. 9,1. 83,. 7.4*0. 0/ 

DATA X4/. 5, .7, .8, .9,1. ,1.2, 1.4, 1.6, 2. ,3. ,4. ,5. ,6. ,7. ,8. ,10., 5., 

2 20. ,30. ,40. ,50. ,58. ,60, ,2*0.0/ 2 

DATA Y4/2*0 . , . 9, 1 . 68, 2 , 1 3, 3 . , 3 , 48, 4 . , 4 . 48, 5 . 05, 5 . 2, 5 . 3, 5. 25, 5. 2, 

2 5.19,4. 95, 4.48,4.0,3.0,2. 05, . 9, 4*0 . 0/ 

DATA KTAB/18, 20, 23, 23/ 

DATA SUBTR/1 .3, 1 . 19, 1 . 19, 1 • 19/ 

DATA SLD1 / 4.86,3*4.49 / 

DATA SLD4/8. 5, 7. 86, 7. 86, 7. 86/ 

D1F1 = DABS ( SLD - SLD1 (NTYPE) ) 

DIF2 = DABS ( SLD - SLD4 ( NTYPE) ) 

PERC1 = SLD1 ( NTYPE ) / 1 0 . 

PERC2 = SLD4 ( NTYPE ) / 1 0 . 

IF ( DIF1 .GT. PERC1 .AND. DIF2 . GT . 


PERC2 ) GO TO 800 


KFT = 2 

NPT = KTABC NTYPE) 
A = 1115. 

SUB = 0.0 
XOUT =0.0 


IF ( DIF2 .LE. PERC2 ) SUB = SUBTR (NTYPE) 

^F^XINM^T^^NTYPE) .OR. X I N . GT . X ( NPT- 1 , NTYPE) ) GO TO 700 


CALL°TA I NT ( X ( 1 , NTYPE ) , Y ( 1 , NTYPE ) , X I N, XOUT , NPT , KFT , NER, D ) 
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700 CONTINUE 

DELOB = XOUT - SUB 
C 

GO TO 900 
800 CONTINUE 

DELDB =0.0 
900 CONTINUE 
C 

RETURN 

END 

•DECK OSPL 

SUBROUTINE OSPL (DECB, MIKES, NFREQ) 

REAL* 8 DECB 
REAL *8 S, D, DDB 
DIMENSION DECBC 70, 35) 

DO 400 I I = 1 , MIKES 
S = DECB (11,1) 

DO 390 L= 2, NFREQ 
D=DECB( I I , L) 

IF (D.LT.40.) GO TO 390 
DDB=DABS(S-D) 

IF ( DDB . GT .7.5) GO TO 380 

S=DEXP( 1 . 1 1 15)*DEXP(-. 1 9077*DDB ) +DMAX1 (S,D) 

GO TO 390 

380 S=DEXP( 1 . 1406) *DEXP( - . 201 72*DDB ) +DMAX1 (S, D) 

390 CONTINUE 

DECBC 11,34) = S 
400 CONTINUE 
RETURN 
END 

•DECK 0SPL1 

SUBROUTINE 0SPL1 ( DECB, MIKES, NFREQ) 

REAL«8 DECB 
REAL* 8 S, D, DDB 

COMMON/ I DENT/NPO I , KMI C, NPOI F, KLIG, IGLDEB, IGLFIN 
DIMENSION DECB (50, 35) 

DO 400 I I =1 , MIKES 
IF( IGLDEB. EQ.O) I GLDEB= 1 
IFC IGLFIN. EQ. 0) IGLFI N=NFREQ 
S = DECBC I I, IGLOEB) 

DO 390 L=IGLDEB+1 , IGLFIN 
D=DECB( I I , L ) 

IF (D.LT.40. ) GO TO 390 
DDB=DABS(S-D) 

IF (DDB.GT.7.5) GO TO 380 

S=DEXP( 1 . 1 1 15)*DEXP( - . 1 9077*DDB) +DMAX1 (S,D) 

GO TO 390 

380 S=DEXP( 1 . 1406) *DEXPC - . 201 72*DDB) +DMAX1 (S, D) 

390 CONTINUE 

DECBC I I , 34) = S 
400 CONTINUE 
RETURN 
END 

•DECK OUTCOR 

SUBROUT I NE OUTCOR ( CORR , M I KEA , M I KEB , NFREQ ) 

THIS SUBROUTINE PRINTS OUT THE ARRAY ’CORR' FOR NEAR AND FAR FIELDS . 
REAL* 8 CORR 
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DIMENSION CORR( 50, 33) 

FORMAT ( 1H1 ) 

MIC = MIKEA 

J=1 FOR NEAR-SIDELINE MIKES (MIKEA) 
J=2 FOR FAR-SI DELINE MIKES (MIKEB) 

IF ( MIC .GT. 13 ) MIC = 13 
MICADD = MIC 
MICNUM = MIC 
Ml = 1 

DO 2000 J = 1 , 2 


IF ( J .EQ. 1 ) WRITE ( 6,430) 

FORMAT ( 1 HO, 50X, 23HNEAR FIELD MICROPHONES. /) 

IF ( J .EQ. 2 ) WRITE ( 6,460) 

FORMAT ( 1 HI , 50X, 23H FAR FIELD MICROPHONES. / ) 

N1 = 1 

MICNUM = MICADD 

L= 1 FOR THE 1ST 13 MIKES. 

L=2 FOR THE REST OF THE MIKES. 

DO 1500 L = 1 , 2 

IFCL.EQ. 1 )WRITE(6,500) (1,1 = N1 , MICNUM ) 

FORMAT (5X,8HM IKE , 8( I 1 , 8X) , I 1 , 04 ( 7X, I 2) ) 

I F ( L . EQ . 2 ) WR I TE ( 6 , 550) (1,1 = N1 , MICNUM ) 
FORMAT ( 5X.7HMIKE , 12, 11 (7X, 12) ) 

WRI TE(6, 600) 

FORMAT (IX, 4HBAND , / ) 


•K’ REFERS TO THE MIKE NUMBER. 

■I' REFERS TO THE BAND NUMBER. 

DO 1 000 1 = 1, NFREQ 

WRITE(6,900) I , (CORR(K, I ) , K = M1.MIC ) 

FORMAT ( 2X, I 2, 4X, F7 . 2, 1 2 ( 2X , F7 . 2 ) ) 

CONTINUE 

IF ( MIKEA .EQ. MICADD ) GO TO 1700 

Ml = MIC + 1 

N1 = MICNUM + 1 

MIC = MIKEA * J 

MICNUM = MIKEA 


WRI TE (6, 400 ) 

CONTINUE 

CONTINUE 
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c 

N1 = 1 

Ml = MIKEA + 1 
MIC = MIKEA + MICADD 
C 

2000 CONTINUE 

WRITE (6, -400) 

C 

RETURN 

END 

*DECK OUTPUT 

SUBROUTINE OUTPUT (XDI S, DECB, ANGLES, FREQ, MIKES, NFREQ, HTMI KE) 

c 

REAL* 8 ANGLES , DECB , FREQ , HTM I KE , XD I S 

DIMENSION XDIS(70, 2) , DECBC70, 35 ) , ANGLES ( 70 ) , FREQ ( 33 ) , HTM IKE (70) 
C 

LC = MIKES / 15 

I F ( MOD ( M I KES ,15). NE . 0 ) LC = LC + 1 
1ST = 1 

DO 375 J = 1 , LC 
I STP = 1ST + 14 
IF ( ISTP.GT. MIKES) ISTP=MIKES 
C 

WRITE (6,610) ( (K),K=IST, ISTP) 

WRITE (6,620) ( ANGLES(K ) , K= I ST, I STP) 

WRITE (6,625) ( HTMI KE ( K ) , K= I ST, I STP ) 

WRITE (6,630) (XDI S (K , 1 ) , K= I ST, I STP) 

WRITE (6,640) ( XD I S ( K, 2 ) , K= I ST, I STP ) 

WRITE (6,650) 

DO 350 L= 1 , NFREQ 

350 WRITE (6, 670) FREQ(L), ( DECB ( K, L ) , K= I ST, I STP) 

WRITE (6, 710) ( DECB( K, 34 ) , K= I ST, ISTP) 

WRI TE( 6, 720) ( DECB( K, 35) , K= I ST, ISTP) 

C 

WRITE (6,730) 

1ST = ISTP ♦ 1 
375 CONTINUE 
C 

610 FORMAT ( 1 2H M I CROPHONE : , 1 4X, 1 5 ( 2X, I 2, 2X ) ) 

620 FORMAT ( 1 2H ANGLE ( DEG ):, 1 4X, 1 5F6 . 1 ) 

625 FORMAT ( 1 3H HEIGHT (FT) : , 13X, 15F6. 1 ) 

630 FORMAT ( 1 4H CL D I ST ( FT ) : , 1 2X, 1 5F6 . 1 ) 

640 FORMAT (14H REF D I ST ( FT ) : , 1 2X, 1 5F6 . 1 ) 

650 FORMAT ( 1 2H FREQ (HERTZ)) 

670 FORMAT ( 2X, F9 . 0, 1 5X, 1 5F6 . 1 ) 

710 FORMAT ( 1 2H00VERALL SPL, 14X, 1 5F6. 1 ) 

720 FORMAT (5H PNDB, 21 X, 1 5F6 . 1 ) 

730 FORMAT ( 1 HI ) 

RETURN 

END 

*DECK POLFIT 

SUBROUTINE POLF I T( X , Y , M, N, U, C, IP) 


PURPOSE: TO PERFORM A LEAST SQUARES POLYNOMIAL 

CURVE FIT OF DEGREE N USING M GIVEN POINTS. 

X THE ARRAY CONTAINING THE X COORDINATES 

Y THE ARRAY CONTAINING THE Y COORDINATES 
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M 

N 

u 

c 

IP 


THE NUMBER OF 
THE DEGREE OF 
ON RETURN THE 
ON RETURN THE 
PRINT FLAG - 


POINTS TO BE FIT (LIMIT IS 100) 

FIT (LIMIT IS 15) 

ARRAY OF N+1 COEFFICIENTS 
ARRAY OF CORRECTED Y COORDINATES 
- 1 =0N (RESULTS ARE PRI NTED) , 0=0FF ( NO OUTPUT) 


THIS DECK IS INTENDED FOR USE ON THE CDC 7600. IF THIS PROGRAM 
IS BEING USED ON TSS/360, REPLACE THE DIMENSION ARRAY1(13), 
ARRAY 2 ( 1 2) CARD WITH : 

DOUBLE PRECISION ARRAY 1 ( 1 3 ) , ARRAY2 ( 1 2 ) 


REAL* 8 Q , P , A , ALPH , B , S , G , ARRAY 1 , ARRAY 2 , D , XMEA , YMEA , HUH , XMEAN , YMEAN , 
*ERR, YSTDER, El , FI , W1 , W , V, SI , T, T3 , T5 , ROOT , Q7, POS, Q8, PCT 
DIMENSION X ( 35 ),Yt 35 ) , Q ( 1 00 ) , P ( 1 00 ) , C ( 35 ) 

D I MENS ION A ( 1 6 ) , ALPH (12) I B(16),S(16),G(16) 1 U(16) 

DIMENSION ARRAY1 ( 1 3) , ARRAY2( 1 2) 

DATA ALPH/5H A , 5H + B , 5H + C , 5H + D , 5H + E , 5H + F , 

*5H + G ,5H + H ,5H + 1 ,5H + J ,5H + K . 5H + L / 

DATA ARRAY 1/5H ,5H X , 5H X**2, 5H X**3, 5H X**4, 5H X**5, 

*5H X* *6 , 5H X**7,5H X**8,5H X* *9, 5HX** 1 0 , 5HX** 1 1 , 5HX* * 1 2/ 

DATA ARRAY2/5HFI RST, 6HSEC0ND, 5HTHI RD, 6HF0URTH, 5HFI FTH, 5HSI XTH, 
*7HSEVENTH, 6HEI GHTH, 5HNI NTH, 5HTENTH, 8HELEVENTH, 7HTWELFTH/ 

D=DFLOAT (M) 

0(1 )=0.0 


N=N + 1 

IF (N.GT.12) GO TO 230 
IF (M.LT.N) GO TO 240 
XMEA=0 . 0 
YMEA=0 . 0 


HUH = 0 

DO 10 I = 1 , M 
XMEA = XMEA +X ( I ) 

YMEA = YMEA+Y ( I ) 

1 0 HUH = HUH+Y( I ) **2 
XMEAN=XMEA/D 
YMEAN=YMEA/D 

ERR= ( D* HUH -YMEA* *2 ) /(D**2-D) 
IF ( IP. EQ. 0) GOTO 500 
YSTDER=DSQRT (ERR) 

WRITE (6,250) M 
WRITE (6,260) XMEAN, YMEAN 
WRITE (6,270) YSTDER 
500 DO 20 I = 1 , M 
P ( I ) =0 . 0 
20 Q( I ) = 1 . 0 

DO 30 1=1,11 
A( I ) =0. 0 
B ( I )=0. 0 

30 sm =o. o 

El =0.0 
FI =0.0 
W1 =D 
N4 = 1 2 
1 = 1 

40 W=0. 0 

DO 50 L= 1 , M 
50 W=W+Y (L) *Q(L) 
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S( I ) =W/W1 

IF ( I -N4.GE.0) GO TO 80 
IF M -M.GE.O) GO TO 80 
El =0 . 0 
DO 60 L=1,M 

60 E1=E1+X<L)*Q(L)*Q(L) 

E1=E1/W1 
A ( l + 1 ) =E1 
W = 0. 0 

DO 70 L=1,M 

V=(X(L)-E1 )*QCL)-F1*P(L) 

P(L)=Q(L) 

Q(L)=V 
70 W=W+V*V 
FI = W/W1 
B( I +2) =F1 
W1 =W 
1 = 1+1 
GO TO 40 
80 DO 90 L=3 J 12 
90 G( L ) =0 . 0 
G( 2) = 1 . 0 
LL = 2 

DO 130 J= 1 , N 
SI =0.0 

DO 110 L=1,N 

IF ( L . EQ . 1 ) GO TO 100 

LL=L+ 1 

G(LL) =G(LL) -A(L) *G(LL-1 ) -B(L)*G(LL-2) 
100 S1=S1+S(L)*G( LL ) 

110 CONTINUE 
U( J)=S1 
L = N+ 1 

DO 120 I2=2,N 
G ( L ) =G ( L- 1 ) 

120 L=L- 1 
LL = 2 

130 G ( 2) =0 . 0 
T = 0 . 0 

DO 150 L= 1 , M 
C( L ) =0 . 0 
J = N 

DO 140 I 2= 1 j N 
C(L)=C(L)*X(L)+U(J) 

140 J=J- 1 

T3=Y ( L) -C(L) 

150 T = T + T3# *2 

IF (M.NE.N) GO TO 160 
T5=0 , 0 
GO TO 170 

160 T5=T/ ( D-DFLOATC N ) ) 

ROOT = DSQRT ( T5 ) 

IF (IP.EQ.1) WRITE(6,280) ROOT 
170 IF ( DABS C ERR ). LT. 0. 00001 ) ERR = 0.001 
Q7 = 1 . 0-T/ ( ERR* CD-I .0) ) 

LE5S=N- 1 

IF C IP. EQ. 0) GOTO 501 
WRITE (6,290) LESS 
WRITE (6,300) 07 
WRITE (6,310) 
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DO 180 J = 1 ,N 
1 2= J - 1 

180 WRITE (6,320) I 2, ALPH C J ) , U ( J ) 

N1 = N-1 

WRI TE( 6, 330) ARRAY 2 ( N1 ) 

N1 = N 

IF (N1 .GT. 9) N1 =9 ...» 

WRI TE( 6, 340) ALPH( 1 ) , ALPHC 2) , ARRAY 1(2), ( ALPH( l ) , ARRAY 1 ( I ) , I =3, 
IF (N.LE.9) GOTO 191 

WRI TE(6, 350) ( ALPH( I ) , ARRAY 1 ( I ) , I = 1 0, N) 

191 WR I TE (6, 360) 

501 KOUNT = 0 

DO 220 l_=1 ,M 
PGS=DABS (Y(L)-C(L) ) 

IF (POS. LT. 0. IE-08) Y(L)=C(L) 

Q8=Y(L) -C(L) 

IF (C(L) . EQ.O.O) GO TO 200 
PCT = 1 00 . 0*Q8/C ( L ) 

IF (IP.EQ.1) WR I TE ( 6 , 370 ) X< L) , Y ( L) , C( L) , Q8, PCT 
GO TO 210 

200 IF (IP.EQ.1) WRITE (6, 380) X(L),Y(L),C(L),Q8 
210 KOUNT =KOUNT + 1 

IF (KOUNT.LT. 42) GO TO 220 
IF (IP.EQ.1) WRI TE( 6, 360) 

IF (KOUNT. EQ. 42) K0UNT=0 
220 CONTINUE 
N = N- 1 
RETURN 

230 WRITE (6,390) 

STOP 

240 LESS=N-1 

WRITE (6,400) LESS 



RETURN 

c 


250 

FORMAT i 

260 

FORMAT i 

270 

FORMAT ' 

260 

FORMAT i 

290 

FORMAT 

300 

FORMAT 

310 

FORMAT 

320 

FORMAT 

330 

FORMAT 

340 

FORMAT 

350 

FORMAT 

360 

FORMAT 

370 

FORMAT 

360 

FORMAT 

390 

FORMAT 

400 

FORMAT 


END 

*DECK 

PNDB 


SUBROUT 


POINTS =, 14) 

X = , F 1 0 . 4 / 7X, 1 7HMEAN VALUE OF Y 


, FI 0. 4 ) 
ESTIMATE 


FOR Y =,F9,4 //) 


/) 


( 1H1 ,6X, 1 8HNUMBER OF 
( 7X, 1 7HMEAN VALUE OF 
F10.4) 

( 7X, 21 HSTANDARD ERROR OF Y = 

( 1 HO, 6X, 35HSTANDARD ERROR OF 
( 7X, 1 6HDEGREE OF FIT = ,12) 

(7X.23H INDEX OF DETERMINATE = ,F9.7 /) 

( 7X , 4HTERM , 4X , 6HLETTER , 1 OX , 1 1 HCOEFF I C I ENT / ) 

( 8X , I 2 , 6X , A3 , 7X , E23 . 16) 

( 1 HO, 6X, 1 2HEQUATI ON IS ,A8,18H DEGREE POLYNOMIAL 
( 7X, 3HY =, 2A3, A1 , IX, 7(A3, A4, IX) ) 

( // 1 X, 3 ( 3H + ,A2,A5//)) 

( 1 HI , 9X, 8HX-ACTUAL, 7X, SHY-ACTUAL, 8X, 6HY-CALC, 5X, 

1 OHDI FFERENCE, 5X, 8HPCT-DI FF /) 

(7X, FI 2. 6, 3X, FI 2. 6, 3X, FI 2. 6, 3X, FI 0.6, 5X,F8. 4) 

( 7X, FI 2 . 6, 3X, FI 2 . 6, 3X, FI 2 . 6, 3X, FI 0. 6, 5X, SHI NF I N I TE ) 

(IX, 38HERR0R ELEVENTH DEGREE IS THE LIMIT) 

(IX, 44HERR0R -TOO FEW POINTS FOR FITTING DEGREE, 


PNDB( LP, NF, PLDB, OL, ALO, ANN, ANO) 

THIS SUBROUTINE HAS BEEN MODIFIED TO WORK ONLY FOR ONE -THIRD 
OCTAVE BAND WIDTH. 


REAL*8 ALO, ANN, ANO, DL, PLDB 


N1 ) 
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REAL*8 SUMN 

DIMENSION DL(24, 2) , AL0(24 , 2) , ANN (24, 2) , ANO( 24, 2) 

REAL*8 LP(27) , LB ( 24 ) , NOY ( 24 ) , NMAX , NBAR 
N = NF 

I F ( N . GT , 24 ) N=24 
DO 21 1=1,24 

21 LB ( I ) =LP ( I ) 

NMAX=0 . 0 
SUMN=0. 0 
DO 13 I = 1 , N 

NOY ( I ) =DM I N1 ( ANO ( I , 1 )*ANN( I , 1 )**( (LB( I )-ALO( I , 1 ) )/DL( 1,1)), 
1 ANO ( I , 2)*ANN( I , 2 ) * * ( ( LB ( I >-ALO< I ,2) )/DL( 1,2))) 

IFCNOYC I ) .GE. NMAX) NMAX = NOY ( I ) 

13 SUMN=SUMN+NOY< I ) 

NBAR = NMAX+O. 1 5* ( SUMN-NMAX ) 

PLDB=40 .0+10. 0*DL0G 1 0 ( NBAR ) /DLOQ 10(2.0) 

I F ( PLDB . LT . 0 . 0 ) PLDB= 0 . 0 

RETURN 

END 

*DECK POLYX 

REAL#8 FUNCTION POLYX ( COF , KF I T , X ) 

EVALUATE POLYNOMIAL OF ARBITRARY ORDER 
USING HORNER * S RULE. 

COF - COFF I C I ENTS OF POLYNOMIAL 

POLYX = COF ( 1 ) + COF ( 2 ) *X + C0F(3)*X**2 + 

(KFIT + 1 = NUMBER OF COEFF I F I CENTS . ) 

KFIT - HIGHEST POWER OF POLYNOMIAL 

X - VALUE OF INDEPENDENT VARIABLE AT WHICH 
POLYNOMIAL I S TO BE EVALUATED. C 
REAL*8 COF, X 
REAL#8 SUM 
DIMENSION COF (15) 

NP1 =KF I T + 1 
SUM = COF(NPI) 

IF (KFIT.EQ.O) GOTO 20 

DO 10 1=1, KFIT 
J=NP 1 -I 

SUM=COF ( J ) +SUM*X 
10 CONTINUE 

20 POLYX = SUM 
RETURN 
END 

CK READ IN 

SUBROUTINE READ I N ( L I ST, KPF , KODT, ITIT) 


SUBROUTINE READ IN IS RESPONSIBLE FOR READING AND STORING INTO 
COMMON THE DATA AND PARAMETERS TO BE USED FOR PROCESSING. 

AS THE DATA IS READ IT IS ALSO PRINTED TO THE LINE PRINTER 
RESULTS FILE (UNIT 06) . 

ENGINEERS INPUTS AND PARAMETERS ARE READ FROM LOGICAL UNIT 
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ASSIGNED TO VARIABLE LUN, USUALLY 5. 

ANGLES AND DECIBEL READINGS FOR EACH MIKE ARE READ FROM 

LOGICAL UNIT NUMBER I UN WHICH MAY OR MAY NOT BE THE SAME 

AS LUN DEPENDING ON THE CONF I GUARAT I ON CHOSEN BY THE PROGRAMMER. 


REALMS RFACT, V8, TTEMPF, SDTEMF , VTUN, RNZDI N, HTMI K, ALPHA, H, D 
REAL*8 VJ, FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDI A 
REAL*8 PSI S, XDN, PSI 1 , FFSPL, ST, STP, PS I 2, VAMB, VJET, SDHUM, SDTEMP, 
*TTEMP, THUM, PSI LO, PSI HI , ANGLES, DECB2, HTSRCE, HTMI KE, PSI VAL, XDVAL, 
xCOFNR, AN, YY, R2D, D2R, XDIS 

COMMON /SUB1 / VJ, FREQ ( 33 ), THETAS ( 50. 33) , XOVERD ( 50, 33 ) , 

* NTAB ( 33 ) , NTEST , XDMAX C 33 ) , THETSM ( 33 ) , RNZD I A , 

x NZTYPE (10), NFREQ 


COMMON /SUB2/ PS I S ( 50, 35 ) , XDN ( 50, 35 ) , PSI1 ( 50, 35) , PS I 2 ( 50 , 35 ) , 
1 FFSPL( 50, 35) , ST( 35) , STP(35) , 

3 I WT1 , IWT2, VAMB, VJET, KFIT( 2), SDHUM, 

4 SDTEMP, TTEMP, THUM, PS I LO, PSI HI , M I KEA , IBIDON, 

5 ANGLES (70) , DECB2(70, 35 ), HTSRCE, HTMI KE ( 70 ) , 

6 PS I VAL (50) , XDVAL ( 50 , 35 ) , COFNR ( 1 1 ,35),AN,YY, 

7 R2D, D2R, XD I S C 70, 2 ) , I MRC, IBNC, I RC, I AAC, 

8 I PFRQC, I PANGL, I CALL, NTYPE 
COMMON/TRAFLG/KTRAC, KTFFSPL, KTDECBM, KTDECBP 
COMMON/ I DENT/NPO I , KM I C, NPO I F, KL I G , IGLDEB, IGLFIN 
DIMENSION ITIT(1) 


DATA I UN, LUN /5, 5/ 
DATA RFACT /459.6Z 
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WR I TE ( 6, 800 ) 

READ ( I UN , 9 1 0 ) NPO I F , KM I CF , NPO I , KM I C , KL I G , L I ST 
KPF=NPO I F 

FORMAT ( 2( I 5, IX, I 1 ) , 212) 

READ (I UN, 901) NRUN, NTYPE 

WRITE (6,801) NZTYPE, NTEST, NRUN, NTYPE, NPOI , KMI C, NPOI F, KM1 CF 


READ (I UN, 902) I PFRQC, I PANGL 
WRITE (6,802) I PFRQC , I PANGL 


READ ( I UN, 902 ) I MRC, I BNC, I RC, I AAC 
WRITE (6,807) 1 MRC, I BNC, I RC, I AAC 


C 


C 

C 


.ECTURE DES FLAG DE TRACE 

!EAD( 1 UN, 902 )KTRAC, KTFFSPL, KTDECBM, KTDECBP 
IEAD( IUN, 1910) ( I T I T ( I ) , 1 =1 , 20) 

IRI TE( 6, 81 OJKTRAC, KTFFSPL, KTDECBM, KTDECBP 
tEAD (IUN, 903) M I KEA, KF I T ( 1 ) , KF I T ( 2 ) , I WT1 , I WT2, 


IGLDEB, IGLFIN 


READ (I UN, 904) AN, YY , PSI LO, PSI HI 
WRITE (6,804) AN, YY , PS I LO , PS I H I 
AN=AN*3. 2808 
YY=YY*3. 2808 


READ (I UN, 902) I TMPTP 

IF ( I TMPTP . NE . 0 . AND . I TMPTP . NE . 1 ) STOP 3 
IF ( I TMPTP. NE. 1 ) GOTO 200 
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READ (I UN, 905) V8, VAMB, THUM, TTEMPF, SDHUM, SDTEMF 
C 

C THESE VARIABLES ARE SET EQUAL DUE TO NUMEROUS PROGRAM CHANGES. 

C 

V JET = V8 
VTUN = VAMB 
C 

c 

TTEMP = TTEMPF +RFACT 
SDTEMP = SDTEMF+RFACT 
GOTO 210 

200 READ ( I UN, 905) V8, VAMB, THUM, TTEMP, SDHUM, SDTEMP 
TTEMPF = TTEMP -RFACT 
SDTEMF = SDTEMP -RFACT 
210 RNZDIN » RNZDI A*12. 0 
C 

WRITE (6,806) V8, VTUN, THUM, SDHUM, RNZDI N, RNZDI A, TTEMPF, TTEMP, 

* SDTEMF, SDTEMP 
READ (I UN, 908) HTSRCE, HTMI K 
I F ( KODT . NE . 0 ) GO TO 100 

C LECTURE LIGNE 1 -BRUIT DE FOND ET MESURE 

I F ( KPF . EQ . 0 ) GO TO 300 
KPT a 1 

CALL RECHPO I N ( KPT , NPO I F , KB 1 D , NFREQ , M I KEA , KM I CF , KL I G , DECB2 , FREQ . 
•ANGLES) 

KPT=2 

300 CALL RECHPOIN(KPT,NPOI , KPF, NFREQ, M I KEA, KMI C, KLI G, DECB2, FREQ, 
•ANGLES) 

GO TO 400 

100 I F ( KODT . EQ . 1 ) CALL LCART 

I F ( KODT . EQ . 2 ) CALL RECHNASA ( NFREQ , M I KEA , DECB2 , FREQ , ANGLES ) 

400 WRI TE( 6, 803 ) M I KEA, KF I T ( 1 ) , KF I T ( 2 ) , I WT1 , I WT2 
DO 101 J = 1 , M I KEA 

101 HTM I KE ( J ) = HTM I K 

WRITE (6,809) HTSRCE, ( HTMI KE( 1 ), I * 1 , Ml KEA) 

809 FORMAT ( / IX, 20HS0URCE HEIGHT (FT) =, F6.2 / 

• 1 X, 20HMI CROPHONE HEIGHT =, 1 5F6 . 2 / 2( 21 X, 1 5F6. 2/ ) 21X, 15F6.2) 


CALCULATION OF MIKE DISTANCES BASED ON 

MIKE HEIGHT AND ANGLE . . . SEE PROGRAM DOCUMENTATION 
FOR REFERENCE ON METHOD USED (GEOMETRY) 

DO 110 L= 1 , MI KEA 

IF (HTSRCE. EQ. HTMI KE( L) ) GOTO 112 
XDI S( L, 2 ) = AN/DSIN( (180. -ANGLES(L) )*D2R) 

XDI S ( L, 1 ) = XDI S(L, 2) *DCOS( (180. -ANGLES(L) ) *D2R) 

GOTO 110 

112 IF (ANGLES(L) .GT. 90. ) ALPHA=90. -ANGLES(L) 

IF (ANGLES(L) . LT. 90. ) ALPHA=ANGLES(L) -90. 

H = HTSRCE-HTM I KE ( L ) 

IF ( ANGLES ( L ) . EQ . 90 . ) GOTO 113 
D = AN/DCOS ( ALPHA*D2R ) 

XD I S( L, 1 ) = DSQRT ( AN*AN+D*D) 

C***»* ECRITURE YY 

XD I S ( L, 2 ) a DSQRT (0*D+H*H) 

GOTO 1 1 0 

113 XD I S ( L, 1 ) = 0.0 

XD I S( L, 2 ) = DSQRT ( AN* *2+H* *2 ) 
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110 CONTINUE 

WRITE (6,805) (XDI S< L, 1 ) , L= 1 , MIKEA) 
WRITE (6,808) (XDI S( L, 2) , L= 1 , MI KEA ) 
C 

C**»** INPUT FORMATS 
C 

901 FORMAT! 21 3) 

902 FORMAT (611) 

903 FORMAT (712) 

904 FORMAT (4F6.2) 

905 FORMAT (8F10.1) 

908 FORMAT (16F5.0) 

909 FORMAT (16F5.2) 

1910 FORMAT (20A4) 


C*****OUTPUT FORMATS 
C 

800 FORMAT! 1 HI , 47HS0URCE LOCATION PROGRAM - AMBIENT VELOCITY CASE 

* // IX, 

* 40H INPUT PARAMETERS READ FOR THIS EXECUTION /) 

801 FORMAT ( 1 X , 1 6H I DENT I F I CAT I ON =,1X, 1 0A4, 5X, 4HTEST, 14, 5H RUN , 

* I 3/ 1 X , 1 3HN0Z2LE TYPE = , I 2, 60X, 6HP0 1 NT ,I4,4H M , I 1 , 5X, 7HB DE F 
*, 14, 4H M , I 1 ) 

802 FORMAT ( 1 X, 1 6H0UTPUT FLAGS =,1X,6I1) 

803 FORMAT!/ IX, 1 9HNEAR FIELD MIKES = ,12 / 

*1X, 10HKFIT(1 ) = , 12, 19X, 10HKFIT(2) = ,12, /IX, 

* 1 OH I WT1 = , 12, 19X, 10HIWT2 = ,12) 

804 FORMAT ( // 1 2X, 1 OHNEAR FIELD, 6X, 9HFAR FIELD / 

* 1 X, 8HD I STANCE, FI 1 . 3, 5X, FI 1 . 3, 5X, 7HPSIL0 =, F8. 2, 3X, 7HPSIHI =, F8. 2) 

806 FORMAT ( / 1X,8HV JET = , F8 . 2, 1 OX, 7HV AMB =,F8.2 / 

* IX, 8HTHUM = , F8 .2,1 OX, 7HSDHUM = , F8 . 2, 1 0X, 1 2HN0ZZLE DIA =, 
*F8.4,9H INCHES =,F8.4,5H FEET, 

* // 21 X, 5HDEG F, 1 0X, 5HDEG R / 1X,11HTUNNEL TEMP,7X, 

*F7. 1 ,8X,F7. 1 / 1 X, 1 2HSTD DAY TEMP, 6X, F7 . 1 , 8X, F7. 1 ) 

805 FORMAT!// 1X,14HMIKE DISTANCES / 

* 1 X, 1 3HCENTER LINE =,10F10.3,/ 3 ( 1 4X, 1 0F1 0. 3 /)) 

807 FORMAT ( 1 X , 1 9HC0RRECT I ON FLAGS =,1X,5I1) 

808 FORMAT ( / 1X,13HS0URCE DIST =,10F10.3 / 3( 1 4X, 1 0F1 0 3 /)) 

810 FORMAT ( 1 PLOT FLAGS = ’,511) 

END 

•DECK LCART 

SUBROUTINE LCART 

REAL*8 VJ, FREQ, THETAS, XOVERD, XDMAX, THETSM, RNZDIA 

REAL*8 PSI S, XDN, PSI 1 , FFSPL, ST, STP, PSI 2, VAMB, VJET, SDHUM, SDTEMP, 

* TTEMP , THUM , PS I LO , PS I H I , ANGLES , DECB2 , HTSRCE , HTM I KE , PS I VAL , XDVAL , 
•COFNR, AN, YY, R2D, D2R, XDI S 

COMMON /SUB1 / VJ, FREQ( 33) , THETAS! 50, 33’ i^OVfRDI 50, 33 ) , 


NTAB ( 33 ) , NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , 
NZTYPE (10), NFREQ 


C 


C 


COMMON /SUB2/ 

1 

3 

4 

5 

6 

7 

8 


PS 1 S ( 50, 35) , XDN (50, 35 ) , PS I 1 ( 50, 35) , PS I 2( 50, 35) , 
FFSPL ( 50 , 35 ) , ST ( 35 ) , STP ( 35 ) , 

I WT1 , IWT2, VAMB, VJET, KFIT(2), SDHUM, 

SDTEMP, TTEMP, THUM, PSI LO, PSI HI , MIKEA, IBI DON, 
ANGLES ( 70) , DECB2(70, 35) , HTSRCE, HTM1KE( 70) , 

PSI VAL( 50) , XDVAL( 50, 35) ,COFNR( 1 1 , 35) , AN, YY , 

R2D, D2R, XDI S( 70, 2) , IMRC, IBNC, IRC, 1AAC, 

IPFRQC, IPANGL, I CALL, NTYPE 


I UN=LUN=5 
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READ (I UN, 903) NFREQ 
903 FORMAT (712) 

READ ( I UN, 905) ( FREQ < I ) , I = 1 , NFREQ) 

905 FORMAT (8F10. 1 ) 

DO 101 J= 1 , M I KEA 

READ ( LUN, 909 ) ANGLES ( J ) , ( DECB2 ( J , L) , L= 1 , NFREQ) 

909 FORMAT (16F5.2) 

101 CONTINUE 
RETURN 
END 

* DECK RECHNASA 

SUBROUTINE RECHNASA ( NFREQ , MI KEA, DECB, FREQ, ANGLES) 

COMMON/ I DENT/ I PT 1 , KBNSA 

COMMON/T I TRE/L I B ( 1 0 ) , IDATE(3),DB1 (8,4) 

REAL*8 DECB (70, 35) , FREQ (33) , ANGLES (70) 

DIMENSION ANG ( 30 ) , SPE ( 30 ) , I PAR< 2) , PAR( 8) , NZTYP( 3 ) , FQ(30) 

DIMENSION TAB 1 (13) , TAB2(30) , TAB3(31 ) , TAB4(31 ) , TABS (31 ) 

EQUIVALENCE (TAB1 ( 1 ) , IPAR( 1 ) ) , (TAB1 (3) , PAR( 1 ) ) , ( TAB1 (11), NZTYP( 1 ) ) 
EQUIVALENCE ( TAB2 (1 ) , FQ ( 1 ) ) 

EQUIVALENCE ( TAB3 ( 1 ) , ANG ( 1 ) ) 

EQUIVALENCE ( TABS ( 1 ), SPE ( 1 ) ) 

DATA ND1 , ND2/2, 3/, NDFQ/5/, LIB0/4H / 

I F ( KBNSA . EQ. 1 )NFREQ=25 
I F ( KBNSA . EQ . 2 ) NFREQ =23 
C LECTURE DU POINT CONTENANT LA L I GNE 1 

READ ( ND 1 , 101 , END=601 ) ( TAB1 ( I ) , I =1 , 13) 

I F( I PT1 . NE . I PAR ( 1 ) )WRITE(6, 104) I PAR ( 1 ) ; STOP 
104 FORMAT (' ERREUR POINT LU = ( ,15) 

NPO I = !PAR( 1 ) 

N= I PAR ( 2 ) 

M I KEA = N 

101 FORMAT ( 31 A4 ) 

DB1 ( 1 , 1 ) =0 . 

DB1 ( 1 , 2)=PAR(5)/3. 2808 
READ( ND1 , 101 ) ( TAB2 ( I ) , I =1 , 30) 

DO 10 1=1, NFREQ 
10 FREQ( I ) = FQ ( I +NDFQ ) 

READ ( ND 1 , 101 ) ( TAB3 ( I ) , I =1 , N) 

DO 20 I =1 , N 
20 ANGLES ( I )=ANG( I ) 

READ ( ND 1 , 1 01 ) ( TAB4 ( I ) , I =1 , N) 

DO 30 1 A= 1 , N 

READ( ND1 , 101 ) ( TAB5 ( I ) , I =1 , 31 ) 

DO 40 I DB = 1 , NFREQ 
40 DECB ( I A, I DB ) = SPE ( I DB + NDFQ ) 

30 CONTINUE 
DO 5 1=1,3 

5 L I B ( I ) =NZTYP ( I ) 

DO 6 1=4,10 

6 L I B ( I ) =L I BO 
DO 7 1=1,3 

7 I DATE ( I )=0 
GO TO 900 

601 WR I TE ( 6, 1 02 ) ND1 

102 FORMAT ( ' FIN DE FICHIER ETIQ. LOGIQUE * ,12) 

STOP 

900 RETURN 
END 

*DECK RECHPOIN 

SUBROUTINE RECHPO I N ( KPT, NPO I , KF, NFREQ, MI KEA, KM I C, KLIG, DECB, FREQ, 
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*ANGLES ) 


INTERFACE PROG AMES ET PROG ONERA 
PAS DE CALIBRATION SUR LES MESURES BRUTES 
RETRAIT DU BRUIT DE FOND SUIVANT CODAGE 
LECTURE BRUIT DE FOND AVANT MESURE 

NO MICROS 

I P I (1 ) =0- 7M, LIGNE 1, MICRO 1 1 

I P I ( 2 ) =0- 7M, LIGNE 1, MICRO 2 2 

I P I ( 3 ) =0- 7M, LIGNE 2, MICRO 1 3 

I PI (4) =0- 7M, LIGNE 2, MICRO 2 4 

IPI (5) =7- 1 4M, LIGNE 1, MICRO 1 5 

IPI (6)=7-14M, LIGNE 1, MICRO 2 6 

IPI (7)=7-14M, LIGNE 2, MICRO 1 7 

IPI (8)=7-14M, LIGNE 2, MICRO 2 8 

REAL* 8 OMEGA (8,40), DECB ( 70 , 35 ) , FREQ ( 33 ) , ANGLES ( 70 ) 

REAL*8 AUX< 70, 30) , DECBF(70, 30) , TM, TF 
COMMON/TST / I TEST ( 70, 30) , N0FR(30) 

COMMON/TI TRE/L I B ( 10) , I DATE( 3 ) , DB1 ( 8, 4 ) , I PI ( 8) 

DIMENSION LTT ( 10) , JFR ( 44 ) , I RG ( 2 ) 

DIMENSION IDB1 ( 8, 6 ) , TETA ( 8 , 40 ) , SDB ( 8, 40, 50) 

DIMENSION TAB1 ( 050) , TAB2( 050) , I TAB ( 6 ) , TAB (4 ) , ANG(40) , SPEC 45) 

EQUI VALENCE ( TAB1 ( 1 ) , T I TR ) 

EQUIVALENCE ( TAB1 ( 2 ) , I TAB ( 1 ) ) 

EQUIVALENCE ( TAB 1 ( 8 ) , TAB ( 1 ) ) 

EQUIVALENCE ( TAB 1 ( 1 2 ) , LTT ( 1 ) ) 

EQUIVALENCE ( TAB 1 ( 22 ) , ANG C 1 ) ) 

EQU I VALENCE ( TAB- 2 ( 1 ) , ANGLE ) 

EQU I VALENCE ( TAB2 ( 2 ) , SPE ( 1 ) ) 

DATA IPI/1 ,2,3,4,5,6,7,8/,NBPIST/4/ 

DATA JFR/3,4, 5, 6 , 8, 1 0 , 1 2, 1 6, 20, 25, 3 1 , 40, 50 , G3, 80, 1 00, 1 25 , 1 60, 200, 
*250, 315,400, 500, 630, 800, 1 000, 1 250, 1 600, 2000, 2500, 3150,4000, 5000, 
*6300, 8000, 1 0000, 1 2500, 1 6000, 20000, 25000, 31 500, 40000, 50000, 63000/ 
DATA I UN/5/ 

FREQUENCE 80 A 20000HZ 


ND = 2 
NUMER =1 
REWIND ND 
50 K0DR=O 
600 CONTINUE 

READ( ND, 1 05, END=61 0) ( TAB1 ( I ) , I =1 , 50) 
105 FORMAT (50A4) 

I F ( I TAB ( 1 ) . NE . NPO I )G0 TO 500 
C NOUVELLE INDEXATION 

I NDEX= I T AB ( 4 ) 

C MISE EN TABLEAU DU TITRE 

DO 12 1=1,10 
12 L I B ( I ) =LTT ( I ) 

l DJ = I TAB (2)/4096 
I DF = I TAB ( 2 ) - 1 DJ *4096 
I UJ= IDF/256 
I DF= I OF- I UJ*256 
I DATE( 1 ) = I DJ* 1 0+1 UJ 
1 DM= I DF / 1 6 
I UM= IDF- I DM* 16 
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I DATE ( 2 ) = I DM* 1 0+ I UM 
I DATE C 3 ) =79 
DO 20 1=1,6 

20 IDB1 ( INDEX, I ) = ITAB( I ) 

DO 22 1=1,4 

22 DB1 (INDEX, I )=TAB( I ) 

DO 24 1 = 1, I TAB (5) 

24 TETA ( INDEX, I )=ANG( I ) 

C REMISE EN ORDRE DES SPECTRESB SI BANDE EN SENS INVERSE 

DO 250 LA = 1 , I TAB ( 5 ) 

I F( I TAB ( 6) . 9T. 1 ) I A= I TAB( 5 ) + 1 -LA; GO TO 170 
I A = LA 

C LECTURE DES SPECTRES 

170 CONTINUE 

READ ( ND, 1 05, END =630) ( TAB2< I ), 1=1,50) 

C RANGEMENT DES ANGLES ET DES SPECTRES 

OMEGA ( INDEX, I A ) = ANGLE 
DO 250 I DB= 1 , 45 
250 SDBC INDEX, I A, IDB)=SPE( IDB) 

NUMER=NUMER+1 

I F ( NUMER . LE . NBP I ST ) GO TO 50 
GO TO 700 

500 DO 25 J = 1 , I TAB ( 5 ) 

READCND, 1 05, END =620 ) ( TAB2 ( I ), 1=1,50) 

25 CONTINUE 
GO TO 600 

610 KODR= 1 

GO TO 650 
620 K0DR=2 

GO TO 650 
630 K0DR=3 

650 WRITEC6, 1 04 ) KODR ; STOP 

104 FORMAT ( 1 ERREUR EN LECTURE BANDE K0DR=',15> 

700 CONTINUE 

MISE EN TABLEAU DES FREQ DES ANGLES ET SPECTRES DE 0A14 METRES 
RANG- 1 DE LA PREMIERE FREQ TRAITEE 
NFDEC= 1 4 
NFREQ=25 

DO 5 I DB= 1 , NFREQ 
5 FREQ ( I DB ) = JFR( I DB+NFDEC ) 

CHOIX DU TRA I TEMENT 
KM I C = 0 MICROS A+ B MOYENNES 
KM I C= 1 MICRO A 
KMI C=2 MICRO B 


I A= I B=0 

C LIGNE 1 OU 2 

I F( KM I C . NE . 0 . AND . KMI C . NE . 1 ) GO TO 1000 
C MICRO A 

IFCKLIG.EQ. 1 ) Ml = I PI (1 );M2=IP! (5) 
IFCKLIG.EQ.2) Ml = I PI (3);M2=IPI (7) 

NT1 = I DB1 (Ml, 5) 

1 = 1 

LEGAL=0 

DO 10 K= 1 , I DB 1 (Ml ,5) 

K1 = I NT (OMEGA (Ml ,K) +0. 5) 

K2= I NT (OMEGA (M2, I ) +0 . 5 ) 

IF(K1 .EQ.K2) 1=1+1; LEGAL=LEGAL+ 1 
10 CONTINUE 



C SECTEUR 0-7M 

DO 30 1=1, IDB1 (Ml , 5) 

1 A= I A+ 1 

ANGLES ( 1 A) =0MEQA(M1 , I ) 

DO 30 I DB= 1 , NFREQ 

30 DECB ( I A, I DB) =SDB(M1 , I , I DB + NFDEC) 
C SECTEUR 7-14M 

DO 40 J= LEGAL +1 , I DB1 (M2, 5) 

I A= I A+ 1 

ANGLES ( I A) =0MEGA(M2, J) 

DO 40 JDB=1, NFREQ 

40 DECB ( l A, I DB) =SDB(M2, J , I DB+NFDEC) 

I F ( KM I C . NE . 0 ) GO TO 2000 
C MICRO B 

1000 IFtKLIG.EQ. 1 ) Ml = I P I ( 2 ) ; M2= I P I ( 6 ) 

I F(KLI G . EQ . 2) Ml = I PI (4 ) ; M2= I PI ( 8 ) 
NT1 = I DB1 (Ml ,5) 


1=1 

LEGAL=0 

DO 1 1 K= 1 , I DB1 (Ml ,5) 

K1 = I NT (OMEGA (Ml ,10+0.5) 

K2= I NT (OMEGA (M2, I ) +0. 5) 

I F(K1 . EQ . K2) 1=1+1; LEGAL=LEGAL+ 1 

11 CONTINUE 
C SECTEUR 0-7M 

DO 31 1=1, I DB1 (Ml ,5) 

I B= I B+ 1 

ANGLES! IB) =0MEGA(M1 , I ) 

DO 31 I DB= 1 , NFREQ 
31 AUX( IB, I DB) =SDB(M1 ,1,1 DB+NFDEC) 
C SECTEUR 7-14M 

DO 41 J=LEGAL+1 , IDB1 (M2, 5) 


IB= IB+1 

ANGLES! IB) =0MEGA(M2, J) 

DO 41 I DB= 1 .NFREQ 
41 AUX( IB, I DB) =SDB(M2, J , I DB + NFDEC) 

I F ( KM I C . NE . 0 ) GO TO 3000 
Ml KEA= I A 

C MOYENNE MICRO A + MICRO B 

DO 70 1=1 , MI KEA 
DO 70 I DB= 1 , NFREQ 

70 DECB ( 1 , I DB ) = ( DECB ( I , I DB ) +AUX (I , I DB ) ) /2 . 


GO TO 5000 
MI KEA= I A 
GO TO 5000 
3000 MI KEA= I B 

DO 72 ! =1 , MI KEA 
DO 72 I DB= 1 , NFREQ 
DECB( I , I DB) =AUX( I , I DB ) 

IF(M1KEA.GT. 70)WRITE(6, 106)MIKEA; STOP 
FORMAT ( 1 TROP D ANGLES LIGNE 1 OU 2 
I F(KF . EQ . 0) RETURN 
SAUVEGARDE BRUIT DE FOND 
IF(KPT. NE. 1 )G0 TO 900 
DO 80 I =1 , MI KEA 
DO 80 I DB= 1 , NFREQ 
DECBF ( I , I DB) =DECB( I , I DB) 

RETURN 
CONTINUE 
DO 81 1=1 , MI KEA 


2000 


72 

5000 

106 


80 


900 


= ‘ . 15) 
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DO 81 I DB= 1 , NFREQ 

81 I TEST ( I , I DB ) =0 

C RETRAIT BRUIT DE FOND 

DO 82 I = 1 , M I KEA 
DO 82 I DB= 1 , NFREQ 
DELT=DECB( I, I DB) -DECBF ( I , I DB ) 

I F( DELT. LE. 0. )DECB( I , I DB) =0. ; GO TO 82 
I F ( DELT . LT . 5 . ) I TEST ( I , I DB ) = 1 000 
TM=DECB( 1 , I DB ) 

TF= DECBF ( I , I DB ) 

DECB( I, I DB) =1 0. *DL0G1 0( 10. ** (TM/10, ) -10. **(TF/10 ) ) 

82 CONTINUE 
RETURN 
END 

• DECK STEST 

SUBROUTINE STEST(MI KES, NFREQ, ANGLES, FREQ) 

0 

REAL*8 ANGLES ( 70 ), FREQ (33) 

COMMON/TST/ I TEST ( 70, 30) 

C TEST BRUIT DE FOND 

WRI TE( 6, 605) 

605 FORMAT ( 1 HI // ' TEST BRUIT DE FOND'//) 

LC = MIKES / 15 

I F ( MOD ( M I KES ,15). NE . 0 ) LC = LC + 1 
1ST = 1 

DO 375 J = 1 ,LC 
ISTP = 1ST + 14 
IF ( ISTP. GT. MIKES) ISTP=MIKES 
C 

WRITE (6,610) ( (K),K=IST, ISTP) 

WRITE (6,620) ( ANGLES ( K ) , K= I ST, ISTP) 

WRITE (6,650) 

DO 350 L=1, NFREQ 

350 WR I TE (6, 670 ) FREQ(L) , ( I TEST ( K, L ) , K= I ST, I STP) 


WRITE (6,730) 
1ST = ISTP + 1 
375 CONTINUE 
C 


610 FORMAT ( 1 2H MI CROPHONE : , 1 4X, 1 5 ( 2X, I Z>, 2X ) ) 
620 FORMAT ( 1 2H ANGLE ( DEG ):, 1 4X, 1 5F6 . 1 ) 

650 FORMAT ( 1 2H FREQ (HERTZ)) 

670 FORMAT ( 2X, F9 . 0, 1 5X, 1 5 ( 2X, I 2, 2X ) > 

730 FORMAT ( 1H1 ) 

RETURN 

END 

•DECK SPCTRA 

SUBROUTINE SPCTRA 


C 


REAL*8 PRESS, FTOM, CONST , RTOK, DEGK, DV, SLD, ABDBM, DELDB, TERM, SPL 
*PHI2,DIST,DI STN, ABSCOR J 1 

REAL* 8 V J , FREQ , THETAS , XOVERD , XDMAX , THETSM, RNZD I A 
REAL*8 PS I S, XDN, PS I 1 , FFSPL, ST, STP, PSI 2, VAMB, VJET, SDHUM, SDTEMP, 
•TTEMP, THUM, PSI LO, PSI HI , ANGLES, DECB2, HTSRCE, HTMIKE, PSI VAL, XDVAL, 
•COFNR , AN, YV , R2D, D2R, XD I S ‘ ‘ 

COMMON /SUB1 / VJ, FREQ ( 33 ) , THETAS( 50, 33) , XOVERD ( 50, 33 ) , 

* NTAB(33) , NTEST, XDMAX (33) , THETSM (33) , RNZDI A, 

* NZTYPE( 10) , NFREQ 

COMMON /SUB2/ PS I S ( 50, 35 ) , XDN ( 50, 35 ) , PS I 1 ( 50, 35 ) , PS I 2 ( 50, 35 ) , 
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FFSPL ( 50, 35 ) , ST ( 35 ) , STP ( 35 ) , 

I WT1 , I WT2, VAMB, VJET, KF I T ( 2) , SDHUM, 

SDTEMP, TTEMP, THUM, PS I LO, PSI HI , MI KEA , IBIDON, 
ANGLES ( 70) , DECB2C70, 35) , HTSRCE, HTMIKEC70) , 

PS I VAL ( 50 ) , XDVAL( 50, 35) , COFNR( 1 1 , 35 ) , AN, YY , 
R2D, D2R, XD I S ( 70, 2 ) , IMRC, IBNC, IRC, I AAC, 

IPFRQC, IPAN0L, I CALL, NTYPE 


PRESS = 1.0 

FTOM = 0.3048 

CONST = 20 . 0*DL0G1 0( YY/AN) 

RTOK = 0.55555556 

DEGK = TTEMP* RTOK 

DV = VJET - VAMB 

SLD = AN / RNZDIA 


PASS THROUGH EACH FREQUENCY AND DEFINE THE FAR FIELD SPECTRA 


IFCNT = 50 
DO 200 J=1 , NFREQ 


= ,F9.3, 17X, 


IF ( NTAB( J ) . EQ . 0) GOTO 250 
WR I TE ( 6, 600 ) FREQ( J ) , ST ( J ) 

600 FORMAT C 1 HI , 1 2H FREQUENCY = , F9 . 0, 1 8X, 1 4HSTR0UHAL NO. 

* 26HRADI AL DISTANCE CORRECTION ) 

WRITE (6. 650) STP (J), CONST 

F0RMAT(40X, 14HST-PRI ME NO. = , F9 . 3, 1 7X, 1 5H20*L0G ( YY/AN ) =,F9.4/) 

WR1TEC6, 675) 

FORMAT (109X, 9HC0RRECTED ) 

FORMAT ( 58X , 1 4HNEAR FIELD SPL, 5X, 1 OHABSORBT I ON, 5X, 1 OHNEAR FIELD, 

* 5X, 13HFAR FIELD SPL ) 

725 F0RMAT?5X 2 3HN0. ,6X,5HPSI-S,8X,2HX2,8X 4HPSn,8X,4HPSI2,6X, 

* 8HAT PS I -S, 8X, 2 ( 1 OHCORRECT I ON, 5X ) , 3X, 8HAT PSI -S ) 


650 


675 


700 


FIND PS I 1 (PSI -ID FOR EACH PSIVAL, XDVAL 
PAIR KNOWN FOR THIS FREQUENCY 

DO 100 I ROW = 1 , IFCNT 
C 

ABDBM =0.0 
DELDB =0.0 
C 

IF ( PS I VAL (I ROW) .NE. 90. ) GO TO 140 

PSI 1 ( I ROW, J) = 90. 

PSI 2( I ROW, J ) = 90. 

GO TO 175 
C 

140 CONTINUE 

IF ( PS I VAL (I ROW) . EQ . 180. ) GO TO 145 

TERM = DTAN( ( 180. -PSIVALt IROW) )*D2R) 

TERM = ( AN/TERM ) +XDVAL ( I ROW , J ) 

IF ( TERM . NE . 0 . ) GOTO 150 
145 CONTINUE 

PSI 1 ( 1 ROW , J ) = 0.0 
GOTO 161 
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150 PS I 1 < I ROW, J ) = - 1 . 0* ( DATANC AN/TERM) ) *R2D 

IF ( PS 11(1 ROW , J ) .LT, 0. ) PS 11(1 ROW, J ) = PSI1(IR0W,J) + ISO. 


DETERMINE PSI-I2 FOR EACH KNOWN PSI-11 

PS! -12 WILL BE USED TO COMPUTE ARBITRARY FAR FIELD SPL 

IF ( PS I VAL ( I ROW ) ,EQ. 180. ) 00 TO 161 

TERM = DTAN( ( 180. -PSIVALC I ROW) )*D2R) 

TERM = (YY/TERM) +XDVALC I ROW, J) 

IF (TERM. EQ. 0. ) GOTO 161 

PS I 2( I ROW, J ) = - 1 . 0* ( DATAN( YY/TERM) ) *R2D 

IF ( PS 1 2 ( I ROW , J ) .LT. 0.) PSI2(IR0W,J) = PSI2(IR0W,J) + 180 
GOTO 175 

161 PS1 2( I ROW, J ) = 0.0 
GOTO 171 


EVALUATE NEAR FIELD SPL AND ADJUST 
FOR DISTANCE FOR PS 1 2 JUST COMPUTED 

175 SPL = POLYXCCOFNRC 1 , J ) , KF I T ( 2 ) , PS I VAL ( 1 ROW) ) 
FFSPL( I ROW, J ) = SPL -CONST 

ADJUST FOR ATMOSPHERIC ATTENUATION 

PHI 2 = 180. - PS I VAL ( I ROW ) 


D1ST = YY/DSI N(PHI 2*D2R) 

CALL A I FAB ( PRESS , DEGK , SDHUM, FREQ ( J ) , ABDBM ) 
FFSPH l ROW, J ) = FFSPLC I ROW, J ) -ABDBM*DIST*FTOM 
DISTN = AN/DSI N( PHI 2*D2R) 

CALL NFCORRt NTYPE, SLD, DISTN, FREQ(J) , DV, DELDB ) 
FFSPLC I ROW, J) = FFSPLC I ROW, J) - DELDB 
C 

GOTO 170 

171 FFSPLC I ROW, J) = 0.0 
C 

170 CONTINUE 

ABSCOR = ABDBM*FTOM*DI ST 
C 


WRI TEC 6, 802) I ROW, PSIVALC 1 ROW) , XDVALC I ROW, J) , PS I 1 ( I ROW, J ) , 

* PSI 2( I ROW, J) , SPL, ABSCOR, DELDB, FFSPLC I ROW, J) 
802 FORMAT ( 5X, I 2, 5X, F7. 2, 5X, F6. 2, 2C5X, F7. 2) 

* F6 .2,1 OX, F7 . 2 ) 


, 8X, 2CF7. 2, 9X ) , 


100 CONTINUE 

CALL WRTEQN C KF I T ( 2 ) , COFNR ( 1 , J ) ) 
GO TO 200 

250 DO 1 10 I RCW= 1 , IFCNT 
110 FFSPLC I ROW, J)=0. 

200 CONTINUE 


RETURN 

END 

*DECK SUBPDB 

SUBROUTINE SUBPDB ( M I KES, DEC I BL , NFREQ ) 

REAL*8 DEC I BL 

REAL*8 DL, ALO, ANN, ANO, PDB 



34 

51 


260 

270 

280 

*DECK 


REAL* 8 LP 

DIMENSION DECIBLI70, 35) , LP(27) 

D I MENS ION DL ( 24 , 2 ) , ALO ( 24 , 2 ) , ANN (24,2), ANO (24,2) 

DATA DL/15*10. , 9*1 10. , 30. , 25, , 2*26. 

1 ,28. ,2*27. ,30. ,51 . ,6*10. ,7*110. ,6. ,9./ 

DATA ALO/52. ,51 . ,49. ,47. ,46. , 45. ,43. ,42. ,41 ., 5*40. , 3 8 

1 , 32 . , 30 . , 2*29 . , 30 . , 31 . , 34 . , 37 . j 64 . , 60. , 56. , 33 

2 ,46. ,44. ,42. , 5*40. , 38 . , 34 . , 32 . , 30 . ,2*29. , 30/ 3 •< 
DATA ANN/ 1 5*2 . , 9* 1 975 . , 13.5, 1 0 , 3, 2*9 . 07, 9 . 76, 2*7 . 94 , 9 . 15, 

1 136.7,6*2. ,7*1975. , 1 .79,2.4/ 

DATA A NO/48* 1 . 0/ 

L24 = 24 

IF ( NFREQ .LT. 24 ) L24 = NFREQ 
DO 280 11=1 .MIKES 
KSW = 0 

DO 260 L= 1 , L24 

LP(L) = DEC I BL( I I , L+6) 

IF (LP(L) .QT.O.O) KSW = 1 
IF (LP(L) . LT. 0. 0) LP ( L ) = 0.0 
CONTINUE 

IF (KSW.GT.O) 00 TO 270 
PDB=0 . 

00 TO 280 
CONTINUE 
NF = L24 

CALL PNDB ( LP , NF , PDB , DL , ALO , ANN , ANO ) 

DECIBLt 11,35) = PDB 

RETURN 

END 

SUBROUTINE TAINT (XTAB, FTAB, X, FX, N, K, NER, MON) 
REAL* 8 FTAB, FX,X, XTAB 
REAL*8 T , C 

DIMENSION XTAB ( 1 ) , FTAB ( 1 ) , T(10), C(10) 

REAL*8 MON 
IF (N-K) 1, 1, 2 


1 NER = 2 
RETURN 

2 IF (K-9) 3, 3, 1 

3 IF (MON) 4, 4, 5 

5 IF (MON-2. ) 6, 7, 

4 J = 0 

NM1 = N-1 
DO 8 1=1 

I F (XTAB( I ) 

1 1 NER = 3 
RETURN 

9 J = J - 1 
00 TO 8 

10 J = J + 1 

8 CONTINUE 
MON = 1 . 

IF (J) 12, 6, 6 

12 MON = 2. 

7 DO 1 3 I = 1 , N 
IF (X-XTAB(D) 

14 J = I 

GO TO 18 

13 CONTINUE 


NM1 

- XTAB( 1+1)) 9, 11, 10 


14, 14, 13 


. ,48. 

37. ,41 . / 
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GO TO 15 

6 DO 16 I = 1, N 

IF (X-XTABCI)) 17, 17, 16 

17 J = I 

GO TO 16 
16 CONTINUE 
15 J = N 

18 J = J - (K+ 1 )/2 

IF (J) 19, 19, 20 

19 J = 1 

20 M = J+K 

IF <M-N) 21, 21, 22 

22 J = J - 1 
GO TO 20 

21 KP1 = K + 1 
JSAVE = J 

DO 23 L = 1, KP1 
C(L> = X-XTAB(J) 

T(L) = FTAB(J) 

23 J = J + 1 

DO 24 J = 1, K 
I = J + 1 

25 T( I ) = (C(J) * TCI) - CCI) * T ( J ) ) / (C(J) - CCI)) 

1 = 1 + 1 

IF (I - KP1 ) 25, 25, 24 

24 CONTINUE 
FX = TCKP1 ) 

NER = 1 
RETURN 

END 

*DECK THMERG 

SUBROUTINE THMERG 

INSERT THETSM INTO THETAS AND INSERT XDMAX INTO XOVERD 


C 


C 


REAL*8 VJ, FREQ, THETAS, XOVERD, XDMAX, THETSM, RN2DI A 

REAL*8 PS IS, XDN, PS I 1 , FFSPL, ST, STP, PSI 2, VAMB, VJET, SDHUM, SOTEMP, 

* TTEMP , THUM , PS 1 LO , PS I H I , ANGLES , DECB2 , HTSRCE, HTM I KE, PS I VAL , XDVAL , 
*COFNR, AN, YY, R2D, D2R, XDIS J 

COMMON /SUB1 / VJ, FREQ ( 33 ), THETAS ( 50, 33) , XOVERD ( 50, 33 ) , 


NTAB C 33 ) , NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A, 
N2TYPEC 10), NFREQ 


COMMON /SUB2/ 


1 

3 

4 

5 

6 

7 

8 


PSISC50, 35) , XDNC 50, 35 ), PSI 1 ( 50, 35) , PS I 2 C 50, 35 ) . 
FFSPL ( 50, 35) , ST ( 35) , STPC 35) , 

I WT1 , I WT2, VAMB, VJET, KFITC2) , SDHUM, 

SDTEMP , TTEMP , THUM, PS I LO, PS I H I , M I KEA, I B I DON , 
ANGLES ( 70 ) , DECB2 (70,35), HTSRCE, HTMI KE ( 70 ) , 

PS I VAL ( 50 ) , XDVAL (50,35), COFNR ( 1 1 , 35 ) , AN, YY , 

R2D, D2R, XD I S ( 70, 2 ) , IMRC, IBNC, IRC, IAAC, 

1 PFRQC, I PANGL, I CALL, NTYPE 


DO 500 J = 1 , NFREQ 
C 

NTB = NTAB(J) 

IF ( NTB .GT. 50 ) NTB = 50 
NTBAD1 = NTB + 1 
C 

DO 400 1=1, NTB 
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c 


IF ( THETSM(J) 
IF ( THETSM(J) 
IL = NTBAD1 - 


. EQ. THETAS ( I , J ) ) BO TO 500 
. GT . THETAS ( 1 , J ) ) GO TO 400 


move the rest of the elements forward so that the appropriate place is 

I [f E THE F ARRAY E HAS W 50 A ELEMENTS ALREADY . THE LAST ELEMENT WILL BE LOST TO 
MAKE ROOM FOR THE NEW VALUE. 


DO 300 L = 1 , IL 
LTB = NTBAD1 - L 
I F ( LTB . EQ . 50 ) GO TO 300 
THETAS ( LTB+ 1 , J ) = THETAS ( LTB, J ) 

XOVERD ( LTB+ 1 , J ) = XOVERD ( LTB, J ) 

300 CONTINUE 

INSERT THE SINGLE VALUE INTO THE EMPTIED SLOT 

THETAS ( l, J) = THETSM(J) 

XOVERD ( I , J ) = XDMAX(J) 

NTAB(J) = NTAB(J) + 1 
GO TO 500 

400 CONTINUE 


CHECK IF THE SINGLE VALUE IS GREATER THAN THE LAST ELEMENT OF THE ARRAY 


IF ( THETSM(J) .LE. THETASt NTB , J ) ) GO TO 500 

LST = NTB+1 

IFCNTB .EQ. 50 ) LST = 50 
THETAS( LST, J ) = THETSMCJ) 

XOVERD ( LST, J) = XDMAX(J) 

NTAB(J) = NTAB(J) + 1 


C 

500 CONTINUE 
RETURN 
END 

*DECK WRTEQN 

SUBROUTINE WRTEQN (N,COEF) 


REAL*8 COEF 

REAL*8 ALPH, ARRAY 1 , ARRAY 2 

DIMENSION COEF ( 12), ALPHI 12), ARRAY 1 (13), ARRAY 2 ( 12) 


DATA ALPH/5H A , 5H+ B 
* , 5H+ H , 5H+ I , 5H+ J 
DATA ARRAY 1/5H , 5HX 

* 5HX**7 , 5HX* * 8 ,5HX**9 


, 5H+ C , 5H+ D 
5H+ K , 5H+ L / 

, 5HX* *2 , 5HX**3 ,5HX**4 
, 5HX* * 1 0, 5HX** 1 1 , 5HX* * 1 2/ 


,5H+ E , 5H+ F ,5H+ G 


, 5HX* *5 , 5HX**6 


DATA^ARRAY2/5HF I RST, 6HSEC0ND?5HTHi RD, 6HF0URTH, SHF I FTH, 5HSI XTH, 
1 ?SsEVe5?S ! liSlii TH ; 5HN I NTH , 5HTENTH , 8HELEVENTH , 7HTWELFTH/ 

NN = N + 1 


C 


101 


FORMAT ( // 1 X , 32HEQUAT 1 ON DEFINING NEAR FIELD SPL 
* 1 X , 27H ( WHERE Y=SPL J X= ANGLE PSIS) /) 


/ 
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WRITE (6,310) 

DO 180 J=1 , NN 
I 2= J - 1 

180 WRITE (6,320) I 2, ALPH( J ) , COEF( J ) 
N1 = NN- 1 

WRI TE (6, 330 ) ARRAY2(N1 ) 

N1 = NN 

IF (N1.GT.9) N1=9 


WRI TE( 6, 340) 
IF (NN.LE.9) 
WRI TE( 6, 350) 


ALPH ( 1 ) , ALPH ( 2 ) , ARRAY 1(2), ( ALPH( I ) , ARRAY 1 ( I ), 
GOTO 191 * 
( ALPH( 1 ), ARRAY 1 ( I ) , I = 10,NN) 


191 RETURN 
310 FORMAT 
320 FORMAT 
330 FORMAT 
340 FORMAT 
330 FORMAT 
END 
*DECK TDECB1 

SUBROUTINE TDECB1 (KPLANC, DECB, ANGLES, FREQ, NFREQ, MI KEA, 
1 IT1T,NCAR,XM0D) 


( 7X, 4HTERM, 4X, 6HLETTER, 10X, 1 1 HCOEFF I C I ENT/ ) 

( 8X, 1 2, 6X, A3, 7X, E23 , 16) 

( 1 HO, 6X, 1 2HEQUATI0N IS ,A8,18H DEGREE POLYNOMIAL /) 
( 7X , 3HY = , 2A3, A1 , 1 X, 7 ( A3, A4 , 1 X) ) 

( // 1 X, 3 ( 3H + ,A2,A5//)) 


SOUS -PROGRAMME DE TRACE DES COURBES DECB =F( ANGLES) 

C**a** 


= 3,N1 ) 


REAL *8 DECB ( 70, 35 ) , ANGLES ( 70 ) , FREQ ( 33 ) 
COMMON /IDENT/NPOI , KM I C, NPO I F, KL I G 
COMMON /Tl TRE/LIBI 10) , I DATE( 3) , DB1 ( 8 , 4 ) 
DIMENSION I T I T ( 1 ) , XMOD( 1 ) 

c* ** * * 


IPI (8) 


DIMENSION SANG ( 1 30 ) 

*ETAS(2)° N NAM(7),NASA(5) ' I PO I NT ( 2 ) , I X ( 2 ) , IY(2), NM I C ( 2 ) , I DEG( 1 ) , I TH 
DIMENSION M I CRO ( 4 ) , MO I NS ( 1 ) 

S!!SS ! ™ x?S?»’ V ti «? ' 8 > ' ' 1 " ■ 1 2 ' . ' * ( i > . > H2 m 

DIMENSION 01 FF( 70) 

D I MENS ION NTR( 15), NEP( 15), NPL (13) 

C*«xaa 


DATA CX/300. /, CY/210. / 

DATA NAM/ ' P9- J . COURATI N PR0G.N0ISE4 V 

DATA NASA/ 'N. A. S. A. /O. N. E. R, A. V 
DATA IPOINT/ 'POINT V,IX/'X= M'/,IY/‘Y= 

* = V 


M ’ /, NMI C/ 1 MICRO 


DATA IANG/50, 90, 1 30, 1 70/ 

DATA XIANG/13. , 43 . , 73 . , 1 03 . , 1 53 . , 1 83 . , 21 3 . ,243./ 

^DAT A I DEG/ 1 DEG ' /,I5DB/'5DB V, I FREQ/ 1 FREQ . ’/, I THETAS/ ' THETAS 


DATA MO I NS/'- ' /, I HZ/ ' HZ 

DATA NTR/ 1,2, 3, 4, 5, 1,2, 3, 4, 5, 
DATA NEP /I, 2, 1,1,1, 1,2, 1,1,1, 
DATA NPL/ 1 , 1 , 1 , 1 , 1 , 2, 2, 2, 2, 2, 
C***»* TRAI TEMENT LIGNE 1 


/, I A/ 'A 
1 , 2, 3,4, 5/ 
1 , 2 . 1 , 1 , 1 / 
3, 3, 3, 3, 3/ 


'/ 


I L I GN= 1 

C««»x» INITIALISATION DES VALEURS X , Y , SANG ET 
C»«*«* INITIALISATION DES VALEURS POUR LA LIGNE 1 
140 CONTINUE 

IF(KLIG.EQ. 1 )X = DB1 (IPK1), 1 ),Y = DB1 ( IPK1 ),2) 
I F(KLIG. EQ. 2)X = DB1 ( I PI (3) , 1 ) ; Y = DB1 ( I PI (3) , 2) 


MICRO 


126 



DO 150 1=1, Ml KEA 
SANG ( I ) =SNGL ( ANGLES ( I ) ) 

D I FF ( I ) =SNQL ( DECB (1,34)) 

150 CONTINUE 

NBPT=MIKEA 

IF(KLIG. EQ. 2) GO TO 260 
1 F ( KM I C . EQ . 1 ) MICRO! 1 ) = I PI ( 1 > I 
IFCKMIC.EQ. 2) Ml CROC 1 ) = 1 PI (2) ; 

MI CRO( 1 ) = I P I (1 ) 

MI CRO( 2) = ! PI (5) 

MI CRO( 3) = I PI (2) 

MI CR0(4 ) = l PI (6) 

GO TO 160 

260 I F(KMI C. EQ. 1 ) MI CROC 1 ) = I PI (3) ; 

IFCKMIC.EQ.2) Ml CROC 1 ) = I PI (4 ) J 
MI CROC 1 ) = IPI (3) 

MI CROC 2 ) = I PI (7) 

MI CROC 3) = I PI (4) 

M I CRO ( 4 ) = I P I (8) 

C* *** * NOMBRE DE FREQUENCES PAR LI GNE 
160 CONTINUE 
NU= 1 

CALL M I NMAX ( D I FF , NBPT , NU , DM I N , DMAX , XMOD ) 

I DMAX= ( DMAX/ 1 0 . )+1 
I DMAX= I DMAX* 1 0 
I DM I N= 1 DMAX -70 
DMAX= I DMAX 
DM I N= I DM IN 

IFCNFREQ.GT. 25) GO TO 170 
I FD= 1 
I FF=NFREQ 
GO TO 180 
170 CONTINUE 
I FD= 1 
I FF=25 

TRACE DU CADRE ET DU CARTOUCHE 
180 CONTINUE 
XT =10. 

YT=200 . 

ANG=0. 

NC=28 

CALL TPL ( CX, CY , XT, YT , ANG , NAM , NC , XMOD ) 

KODE= 1 
NCL=40 
NC= 1 

CALL TCARTCKODE, CX, CY, LIB, NCL, I DATE, NC, XMOD) 
KPLANC=KPLANC+ 1 

C«**** ECRITURE NASA ET TITRE LU SUR CARTE 
XT=CX- 1 0 . 

YT=CY-55. 

HL = 3. 

HH=5 . 

ANG=270 . 

NC= 1 9 

CALL KSTEP ( 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTEC XT, YT, HL, HH, NASA, ANG, NC, XMOD) 
CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD) 

c**«** 

XT =10. 

YT = 1 80 . 


MI CRO( 2) = I PI (5) ; GO TO 
M I CRO< 2) = I PI (6) ; GO TO 


MI CROC 2) = I PI (7) J GO TO 
MI CRO( 2) = I PI (8) J GO TO 


160 

160 


160 

160 
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HH = 3 . 

ANG=0 . 

CALL KTEXTECXT, YT, HL, HH, I T I T , ANG , NCAR , XMOD ) 
C**#*# ECRITURE DE NPOI , X, Y ET KMIC 
XT =10. 

YT = 1 70 . 

NC = 6 

CALL KTEXTE(XT i YT, HL , HH, I POINT, ANG, NC, XMOD) 
XT = XT +18. 

NC = 4 

CALL KF I XE ( XT, YT, HL, HH, NPO I , ANG , NC, XMOD ) 

XT = XT + 20 . 

NC = 8 

CALL KTEXTECXT, YT, HL, HH, I X , ANG , NC , XMOD ) 

XT =XT +6 . 

NC = 3 

CALL KDEC I M ( XT, YT, HL, HH, X, ANG, NC, XMOD) 

XT = XT +23 . 

NC = 8 

CALL KTEXTE ( XT, YT , HL, HH, I Y , ANG, NC , XMOD ) 

XT = XT + 6 . 

NC = 5 

CALL KDEC IM(XT,YT, HL, HH,Y, ANG , NC , XMOD ) 

XT = XT + 23 . 

NC=8 

CALL KTEXTECXT, YT, HL, HH, NMI C, ANG, NC, XMOD) 

XT = XT +27 . 

NC= 1 

CALL KF I XE ( XT , Y T , HL , HH , MICRO ( 1 ) , ANG , NC , XMOD ) 
XT=XT + 6 , 

CALL KTEXTECXT, YT, HL, HH, MO I NS, ANG, NC, XMOD) 
XT=XT + 6 . 

CALL KF I XE ( XT , Y T , HL , HH , M I CRO ( 2 ) , ANG , NC , XMOD ) 
IFCKMIC.NE.O) GO TO 190 
XT = XT+6 . 

CALL KTEXTECXT, YT, HL, HH , MO I NS , ANG, NC, XMOD) 

XT = XT + 6 . 

CALL KFIXECXT, YT, HL , HH, M I CRO C 3 ) , ANG , NC,XMOD) 
XT = XT +6 . 

CALL KTEXTECXT, YT, HL, HH, MOI NS, ANG, NC, XMOD) 

XT = XT + 6 . 

CALL KF I XE C X T , Y T , HL , HH , MICRO C 4 ) , ANG , NC , XMOD ) 
190 CONTINUE 

C****# ECRITURE 'FREQ. A 1 

XT = 20 . 

YT = 1 55 . 

NC = 5 

CALL KTEXTECXT, YT, HL, HH, I FREQ, ANG, NC, XMOD) 

XT = XT +42 . 

NC= 1 

CALL KTEXTECXT, YT, HL, HH, I A, ANG, NC,XMOD) 

XT = XT + 30 . 

NC = 2 

CALL KTEXTECXT, YT, HL, HH, I HZ, ANG, NC,XMOD) 

XT = 1 60 . 

NC = 5 

CALL KTEXTECXT, YT, HL, HH, I FREQ, ANG, NC, XMOD) 

XT = XT +42 . 

NC= 1 
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CALL KTEXTEIXT, YT, HL, HH, I A, ANG, NC, XMOD) 

XT = XT + 30 , 

NC = 2 

CALL KTEXTEIXT, YTj HL, HH, I HZ , ANG , NC , XMOD ) 

C«***« TRACE DU PREMIER AXE VERTICAL 
XT =10. 

YT =10. 

NC = 0 

PASMM= 1 0 . 

ANG=90 . 

XM I N= 1 . 

PAS= 1 . 

NGRAD= 1 5 

CALL KAXE ( XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD , NF, XMOD) 
Cxxxxx TRACE DU SECOND AXE VERTICAL 
XT = 1 50 . 

YT =10. 

CALL°KAXE(XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, MF, XMOD) 
Cxxxxx TRACE PREMIER AXE HOR I ZONTAL ( PART I E GAUCHE DE LA PLANCHE) 
XT =10. 

YT= 1 0 . 

PASMM =7. 5 
ANG=0 . 

NGRAD= 1 4 

CALL KAXE ( XT , YT , NORD , NC , PASMM , ANG , XM I N , PAS , NGRAD , NF , XMOD ) 
Cxxxxx TRACE PREMIER AXE HOR I ZONTAL ( PARTI E DROITE DE LA PLANCHE) 
XT = 1 50 . 

CALL°KAXE(XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
Cxxxxx ECRITURE DES COTATIONS SUR LES AXES HORIZONTAUX 
YT = 5 . 

HL = 2 . 

HH = 3 . 


NC = 3 

DO 200 1=1,4 
XT = X I ANG ( I ) 

CALL KFIXECXT, YT, HL, HH, I ANG( I ), ANG, NC, XMOD) 


200 CONTINUE 
XT = XT +10. 


NC = 3 

CALL KTEXTECXT, YT, HL, HH, 


I DEG, ANG, NC, XMOD) 


YT =15. 


NC = 6 

CALL KTEXTE(XT, YT, HL, HH, 


I THETAS, ANG, NC, XMOD) 


NC = 3 


Cxxxxx 

YT = 5 , 

DO 210 1=1,4 
XT=XIANG( I +4 ) 

CALL KFI XECXT, YT, HL, HH, I ANG ( I ) , ANG, NC, XMOD) 
210 CONTINUE 
XT = XT +10. 

NC = 3 

CALL KTEXTEIXT, YT, HL, HH, I DEG, ANG, NC, XMOD) 

YT= 1 5 . 

NC = 6 

CALL KTEXTECXT, YT, HL, HH, I THETAS, ANG, NC, XMOD) 
NC = 3 


c***** ECRtTURE 2DB 

xt=8. 

YT = 1 42 . 

HH=2. 

ANG=90 . 

NC = 3 

CALL KTEXTE(XT,YT,HL,HH, I 5DB , ANG , NC , XMOD ) 

XT = 1 48 . 

YT= 142 , 

CALL KTEXTECXT, YT, HL, HH, I 5DB , ANG, NC, XMOD) 
C***«* ECRITURE DES VALEURS MAX 
XT =12. 

YT a 1 50, 

HH = 2 . 

HL=2 . 

ANG=0 . 

NC=5 

CALL KDEC I M ( XT , YT , HL , HH , DMAX , ANG , NC , XMOD ) 

XT = 1 52 . 

CALL KDECI M(XT, YT, HL, HH, DMAX, ANG, NC, XMOD) 
C***«* ECRITURE DES FREQUENCES 
XT = 38 . 

YT = 1 55 . 

NC = 7 
HL = 3 . 

HH=3 . 

ANG=0. 

SFREQ = SNGL ( FREQ C IFD) ) 

CALL KDEC I M ( XT, YT, HL, HH, SFREQ, ANG, NC, XMOD) 

IFC ( IFD+9) ,GE. IFF) GO TO 240 
SFREQ=SNGL ( FREQ( IFD+9) ) 

XT =XT + 30 . 

CALL KDEC I M ( XT , YT , HL , HH , SFREQ , ANG , NC , XMOD ) 

C#*#** 

XT =178. 

SFREQ =SNGL ( FREQ( IFD+10) ) 

CALL KDEC I M ( XT , YT , HL , HH , SFREQ , ANG , NC , XMOD ) 
240 CONTINUE 
XT=XT+30 . 

SFREQ=SNGL ( FREQ (IFF)) 

CALL KDEC I M ( XT , YT , HL , HH, SFREQ, ANG , NC, XMOD ) 

C* **** TRACE DES COURBES 
CXSUJ1 =40. 

CXSUJ2= 1 70 . 

CYSUJ1 =DM I N 
CYSUJ2=DMAX 
CXOB J 1=10. 

CXOB J2= 1 07 , 5 
CYOBJ 1=10. 

CY0BJ2= 1 50 . 

I DEB= I FD 

IFC IFF. GT. ( IFD+9) ) GO TO 280 
I F I N= I FF 
GO TO 290 
280 CONTINUE 

I F I N= I FD+9 
290 CONTINUE 

CALL DEPLACCO. ,XMOD) 

CALL D I MSUJ ( CXSUJ 1 , CXSU J2 , CVSUJ 1 , CYSU J2, XMOD ) 
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CALL D I MOB J ( CXOB J 1 , CX0BJ2, CYOBJ1 , CYOBJ2,XMOD) 
K=0 

DO 340 I = I DEB, I FIN 
DO 320 J=1 ,MIKEA 
D I FF ( J ) = SNQL ( DECB ( J , I ) ) 

320 CONTINUE 
C***«* 

330 CONTINUE 
K=K+1 

I F ( K . QT . 15) WRI TE( 1 08, 500) ; RETURN 
CALL KSTEP( 1 , NTR(K) , NEP(K) , NPL(K) , XMOD) 

CALL KTRACE ( SANO , D I FF , NBPT , XMOD ) 

340 CONTINUE 

CALL KSTEP 11,1,1,1, XMOD ) 

IFC 1FIN.EQ. IFF) GO TO 350 
I DEB= I FI N+1 
I F I N= I FF 
CXOB J 1=1 50 . 

CX0BJ2=247 . 5 
GO TO 290 

350 CONTINUE 

I FI IFF.EQ.NFREQ) GO TO 360 
I FD= I FF + 1 
I FF=NFREQ 

CALL C DEPLAC ( CCX , XMOD ) 

GO TO 180 
360 CONTINUE 
CCX=CX+20. 

CALL DEPLACICCX, XMOD) 


Q*ttK*X 

500 

xDECK 


1 

Cx * x xx 
Cxxxxx 
Cxxxxx 


RETURN 

F0RMATC1X, ’ TROP DE COURBES 1/3 OCTAVES V/> 

END 

TDECB2 

SUBROUT I NE TDECB2 1 KPLANC , DECB , ANGLES , PS I VAL , FREQ , NFREQ , M I KEA , Y Y , 
I T I T , NCAR , XMOD ) 

SOUS -PROGRAMME DE TRACE DES COURBES DECB=F( ANGLES) 

REAL* 8 DECB (50,35), ANGLES (50,35), FREQ ( 33 ) , YY , PS I VAL ( 50 ) 

COMMON /IDENT/NPOI , KM I C, NPO I F, KLI G, IGLDEB, IGLFIN 

COMMON /TITRE/LIB( 10), IDATE(3),DB1 ( 8, 4 J , I PI ( 8) , LIB1 ( 20) , LI B2( 20) 
DIMENSION I T I T ( 1 ) , XMOD( 1 ) 


C* * * ** 


DIMENSION SANG (50) 

DIMENSION NAM ( 7 ) , NASA(5) , I PO I NT ( 2 ) , 1 X( 1 ) , 
D I MENS ION M I CRO ( 4 ) , MO I NS ( 1 ) , I PS 1 2 ( 1 ) 
DIMENSION I ANG ( 4 ) , X I ANG ( 8 ) , I 5DB( 1 ) , I FREQ ( 
* ( 3 ) , I HHZ( 5 ) 

DIMENSION X12(2) ,Y12(2) 

DIMENSION D I FF ( 50) 

DIMENSION NTR( 15), NEP( 15), NPL( 15) 


1 Y ( 3 ) , NM I C ( 2 ) , 1 DEG( 1 ) 

2) , I A( 1 ) , I HZ( 1 ) , I GLOBAL 


C***** 

DATA CX/300 . / , CY/21 0 . / 

DATA NAM/ 'P9-C0URATIN PROG. N0ISE4 V 

DATA NASA/ 'N.A.S.A./O.N.E.R.A. V 

DATA I PO I NT / ' PO I NT V.IX/’X* V,IY/ , Y = 


M ' / , NM I C/ ' MICRO 


*= V, I PS I 2/ 'PSI2V 
DATA I ANG/ 50 , 90, 1 30, 1 70/ 

DATA XIANG/13. ,4 3 . , 73 . , 1 03 . , 1 53 . , 1 83 . , 21 3 . ,243./ 

DATA I DEG/ ’DEG ’ /,I5DB/‘5DB * / , I FREQ/ ' FREQ . '/, I GLOBAL/ ' GLOBAL ( P 

*SIS) / 

DATA MO I NS/’- ‘/^HZ/’HZ '/ t lA/'A '/ 

DATA IHHZ/’C , HZ) V 

DATA NTR/1 ,2, 3, 4, 5, 1 , 2 ( 3 , 4 , 5, 1 , 2 , 3 , 4 , 5/ 

DATA NEP/ 1 , 2, 1 , 1 , 1 , 1 , 2, 1 , 1 , 1 , 1 , 2, 1 , 1 , 1 / 

DATA NPL/1 , 1 , 1 , 1 , 1 , 2, 2, 2, 2, 2, 3, 3, 3, 3, 3/ 

GLDEB=SNGL C FREQ ( I GLDEB ) ) 

GLF I N=SNGL ( FREQ ( I GLF I N ) ) 

C***** TRA I TEMENT LIGNE 1 

C***** INITIALISATION DES VALEURS POUR LA LIGNE 1 
Y=SNGL(YY)/3.2808 
DO 150 I = 1 , MI KEA 
SANGC I ) = SNGL ( PS I VAL ( I ) ) 

D I FF( I ) = SNGL ( DECBC 1,34)) 

150 CONTINUE 
NBPT =M I KEA 

C***** NOMBRE DE FREQUENCES PAR LIGNE 
NU = 1 

CALL Ml NMAX ( D I FF , NBPT , NU , DM I N , DMAX , XMOD ) 

I DMAX = ( DMAX/ 1 0 . )+1 
I DMAX = I DMAX* 1 0 
I DM I N= I DMAX - 70 
DMAX= I DMAX 
DM I N= I DMI N 
DO 190 111=1, NFREQ 
I F( DECB( 1 , I I I ) . LT , 1 . ) GO TO 190 
I F I = I I I 
GO TO 195 
190 CONTINUE 

195 I F ( NFREQ . GT . 25 ) GO TO 170 
I FD= 1 
I FF=NFREQ 
GO TO 180 
170 CONTINUE 
I FD= 1 
I FF=25 

C***** TRACE DU CADRE , DU CARTOUCHE ET DU LI BELLE 
180 CONTINUE 
XT =10. 

YT=200 . 

ANG=0 . 

NC = 28 

CALL TPL ( CX, CY, XT, YT, ANG, NAM, NC, XMOD) 

XT=95 . 

YT=202 . 

NC=80 
HL=2 . 5 
HH=2 . 5 

CALL KTEXTE ( XT, YT, HL, HH, LIB1 , ANG, NC, XMOD) 

YT= 1 95 . 

CALL KTEXTE ( XT, YT, HL , HH, LIB2, ANG, NC,XMOD) 

KODE= 1 
NCL=40 
NC= 1 

CALL TCART (KODE, CX, CY , L I B, NCL, I DATE, NC, XMOD ) 

KPLANC=KPLANC+1 
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0***** ECR1TURE NASA ET TITRE LU SUR CARTE 
XT = CX- 1 0 . 

YT=CY -55 . 

HL = 3 . 

HH = 5 . 

ANG=270. 

NC= 1 9 

CALL KSTEPC1 , 1 ,4, 1 , XMOD) 

CALL KTEXTE(XT, YT, HL, HH, NASA, ANG, NC, XMOD) 

CALL KSTEP XMOD ) 

c## # # # 

XT -10. 

YT= 1 80 , 

HH = 3 , 

ANG=0 . 

CALL KTEXTE ( XTj YTj HL.HH, ITI T, ANG, NCAR, XMOD ) 

YT= 1 70 . 

XT=50 . 

NC = 9 

CALL KTEXTE ( XT, YT, HL, HH , 1 Y , ANG, NC, XMOD ) 

XT = XT + 6 . 

NC = 6 

CALL KDECIMCXT, YT, HL, HH, Y, ANG, NC, XMOD) 
C####*ECRI TURE DU NUMERO DE POINT ET DE B DE F 
XT = 1 00 . 

YT = 1 80 . 

HH = 3 . 

HL = 3 . 

ANG=0 . 

NC = 6 

CALL KTEXTE ( XT , YT , HL, HH, 'POINT ANG , NC , XMOD ) 
XT = 1 30 . 

NC = 4 

CALL KFI XE< XT , YT, HL, HH, NPOI , ANG, NC,XMOD) 

XT = 1 55 . 

NC = 7 

CALL KTEXTECXT, YT, HL, HH, 'B DE F ANG, NC, XMOD ) 
XT = 1 80 . 

NC = 4 

CALL KFIXECXT, YT, HL, HH, NPOI F, ANG, NC, XMOD) 
C##*#* ECRITURE 'FREQ. A 1 

XT = 20 , 

YT= 1 55 . 

NC = 5 

CALL KTEXTE ( XT , YT , HL , HH , I FREQ , ANG , NC , XMOD ) 

XT = XT +42 . 

NC= 1 

CALL KTEXTE(XT,YT, HL, HH , I A , ANG , NC , XMOD ) 

XT = XT + 30 . 

NC = 2 

CALL KTEXTE ( XT, YT, HL, HH, I HZ, ANG, NC, XMOD ) 

C* # * * * 

XT = 1 60 . 

NC = 5 

CALL KTEXTE ( XT, YT , HL, HH, I FREQ, ANG, NC, XMOD) 

XT = XT +42 . 

NC= 1 

CALL KTEXTE(XT, YT, HL, HH, l A, ANG , NC , XMOD ) 

XT = XT + 30 , 

NC = 2 
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CALL KTEXTE(XT,YT,HL,HH, I HZ , ANG , NC, XMOD ) 

C***** TRACE DU PREMIER AXE VERTICAL 
XT =10. 

YT =10. 

NC = 0 

PASMM= 1 0 . 

ANG=90 . 

XM I N= 1 . 

PAS= 1 . 

NGRAD= 1 5 
NF=0 

CALL KAXE(XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
Cxxxx* TRACE DU SECOND AXE VERTICAL 
XT = 1 50 . 

YT= 1 0 . 

NGRAD= 1 5 

CALL KAXE ( XT , YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
Cxxxxx TRACE PREMIER AXE HOR I ZONTAL ( PART I E GAUCHE DE LA PLANCHE) 
XT =10. 

YT =10. 

PASMM=7 . 5 
ANG=0 . 

NGRAD= 1 4 

CALL KAXE (XT, YT, NORD, NC, PASMM, ANG, XMI M, PAS, NGRAD, NF, XMOD) 
C***x* TRACE PREMIER AXE HOR I ZONTAL ( PART I E DROITE DE LA PLANCHE) 
XT = 1 50 . 

YT =10. 

CALL KAXE (XT, YT, NORD, NC, PASMM, ANG, XM I N, PAS, NGRAD, NF, XMOD ) 
C****» ECRITURE DES COTATIONS SUR LES AXES HORIZONTAUX 
YT = 5. 

HL = 2. 

HH = 3 . 

NC=3 

DO 200 1=1,4 
XT = X I ANG ( I ) 

CALL KFI XE(XT, YT, HL, HH, I ANG ( I ), ANG, NC, XMOD ) 

200 CONTINUE 
XT = XT +10. 

NC = 3 

CALL KTEXTE ( XT , YT, HL, HH, I DEG, ANG, NC, XMOD ) 

YT =15. 

NC=4 

CALL KTEXTE ( XT, YT, HL, HH, I PS I 2, ANG, NC, XMOD) 

NC = 3 

Ox xx x x 

YT = 5 . 

DO 210 1=1,4 
XT = X I ANG ( I +4) 

CALL KFIXE(XT, YT, HL, HH, I ANG ( I ) , ANG, NC,XMOD) 

210 CONTINUE 
XT = XT +10. 

NC = 3 

CALL KTEXTE (XT, YT, HL, HH, I DEG, ANG, NC, XMOD ) 

YT= 1 5 . 

NC = 4 

CALL KTEXTE ( XT , YT, HL, HH, I PSI 2, ANG, NC, XMOD) 

Cxxxxx ECRITURE 2DB 
XT = 8 . 

YT = 1 42 . 

HH = 2 . 
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ANG=90. 

NC = 3 

CALL KTEXTECXT, YT, HL, HH, I 5DB, ANG, NC, XMOD) 

XT = 1 48 . 

YT= 142. 

CALL KTEXTECXT, YT.HL.HH, I 5DB , ANG , NC , XMOD ) 
ECRITURE DES VALEURS MAX 
XT = 12. 

YT = 1 50 . 

HH = 2. 

HL = 2. 

ANG=0 . 

NC = 5 

CALL KDECIMCXT, YT, HL, HH, DMAX, ANG, NC, XMOD) 

XT = 1 52 

CALL KDEC I M ( XT , YT , HL , HH , DMAX , ANG , NC , XMOD ) 
C*** * * ECRITURE DES FREQUENCES 
XT=38 . 

YT = 1 55 . 

NC = 7 
HL=3. 

HH = 3 . 

ANG=0 . 

SFREQ=SNGL ( FREQ ( I F I ) ) 

CALL KDECIMCXT, YT, HL, HH, SFREQ, ANG, NC, XMOD) 
IFC ( IFD+9) .GE. IFF) GO TO 240 
SFREQ=SNGL(FREQ( IFD+9) ? 

XT = XT + 30 . 

CALL KDEC I M ( XT , YT , HL , HH , SFREQ , ANG , NC , XMOD ) 
C***** ECRITURE GLOBAL 
XT = 1 02 . 

YT = 1 40 . 

NC "12 

CALL KTEXTECXT, YT. HL, HH, I GLOBAL, ANG, NC, XMOD) 
NC = 20 
YT= 1 34 . 

HL = 2 . 

HH ~ 2 

call' KTEXTECXT, YT, HL, HH, 1 HHZ, ANG, NC. XMOD) 

XT =104. 

NC = 7 

CALL KDEC I M C XT , YT , HL , HH , GLDEB , ANG , NC , XMOD ) 

XT = 1 20 

CALL KDECI M(XT, YT, HL, HH, GLF I N , ANG, NC, XMOD) 

HL = 3 . 

HH = 3 . 

C* * * * # 

XT = 1 78 . 

YT = 1 55 . 

SFREQ =SN0L ( FREQ ( IFD+10) ) 

CALL KDEC I M ( XT , YT . HL , HH , SFREQ , ANG f NC , XMOD ) 
240 CONTINUE 
XT = XT + 30 . 

SFREQ =SNGL( FREQ( IFF) ) 

CALL KDECIMC XT, YT, HL, HH, SFREQ, ANG, NC, XMOD) 
C***** TRACE DES COURBES 
CXSUJ1 =40. 

CXSUJ2= 1 70 . 

CYSUJ1 =DMI N 
CYSUJ2=DMAX 
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CX0BJ1 =10. 

CX0BJ2= 1 07 . 5 
CYOB J 1=10. 

CYOB J2= 1 50 . 

I DEB = I FD 

IF< IFF.GT. ( IFD+9) ) GO TO 280 
I F I N= I FF 
GO TO 290 
280 CONTINUE 
I FI N= I FD+9 
290 CONTINUE 

C* # # * * TRACE DU GLOBAL ( PS I VAL ) 

CALL DEPLAC ( 0 . , XMOD ) 

CALL D I MSUJ ( CXSUJ 1 , CXSUJ2, CYSUJ1 , CYSUJ2,XM0D) 
CALL D I MOBJ ( CXOB J 1 , CXGBJ2, CY0BJ1 , CY0BJ2, XMOD) 
CALL KSTEP ( 1 , 1,1, 1,XM0D) 

CALL KTRACE(SANG, Dl FF, NBPT, XMOD) 

C***** TRACE DES 1/3 D 1 OCTAVE (PS12) 

390 CALL DEPLAC ( 0 . , XMOD ) 

CALL DI MSUJ ( CXSUJ1 , CXSUJ2, CYSUJ1 , CYSUJ2, XMOD) 
CALL D I MOBJ ( CXOB J 1 , CX0BJ2, CY0BJ1 , CY0BJ2,XM0D) 
K = 0 

DO 340 I = I DEB, I FIN 

DO 320 J= 1 , M I KEA 

SANG ( J ) =SNGL ( ANGLES ( J , I ) ) 

D I FF ( J ) =SNGL ( DECB ( J , I ) ) 

320 CONTINUE 
C# # * # # 

330 CONTINUE 
K = K + 1 

IF(K.OT.IS) WR I TEC 1 08, 500) ; RETURN 
CALL KSTEP ( 1 , NTR (K ) , NEP ( K ) , NPL CK ) , XMOD ) 

CALL KTRACE ( SANG, D IFF, NBPT, XMOD) 

340 CONTINUE 
C* * * * * 

CALL KSTEP C 1 , 1,1, 1,XM0D) 

IFC IFIN.EQ. IFF) GO TO 350 
I DEB= I F I N+ 1 
I F I N= I FF 
CXOBJ 1=150. 

CX0BJ2=247 . 5 
GO TO 390 

C* * * # # 

350 CONTINUE 

I F ( I FF . EQ . NFREQ ) GO TO 360 
I FD= I FF + 1 
I FF=NFREQ 
CCX = CX + 20 . 

CALL DEPLAC (OCX, XMOD) 

GO TO 180 
360 CONTINUE 
CCX=CX+20 . 

CALL DEPLAC (CCX, XMOD) 

C*#### 

RETURN 

500 FORMAT ( IX, 1 TROP DE COURBES 1/3 OCTAVES '//) 
END 



CPROGRAMMMES DES MISES EN B I BL I OTHEQUE B I BLOM 
I JOB, T TRL, P003, P9C0URA, 40, ( REST) MISE EN B I BLOM DE TPL 
'COMMENT ETUDE=2895PN1 4 1 P 

I COMMENT MISE EN B I BLOM DU SOUS " RR00RA, “'^ „Ie L ^ni 
I LI MI T ( CORE, 50) , ( TIME, 1 ) , (SPDI SC, 50) , ( PAGES, 30) 

I FORTRAN^S^,^ ^ TpL( CXj CY, X, Y , ANG, NAM, NC, XMOP) 

C*»*** SOUS-PROGRAMME DE TRACE DU CADRE DU NOM PLANCHE 

C* * # * * CX = DIMENSION EN MM.SUIVANT L AXE DES ABSCISSES DE LA PLA CHE 

C***** CY = DIMENSION EN MM.SUIVANT L AXE ?| R L f E TRACE 
X , Y = COORDONNEES UTI L I SATEUR ( EN MM) OU DOIT DEBUTER LE TRACE 

s:::: anb-XruSle representant l an®le EN degres entre l axe 

OX DU TRACEUR ET LE SENS D ECR jJURE DU N0M 
C***** NC=NOMBRE DE CARACTERES DU NOM A ECRIRE 
DIMENSION XMOD (44) 

DIMENSION XI 2(5) , Y1 2(5) , NAM( 1 ) 

C***** 

DATA ZERO/O./ 

XI 2 ( 1 )=ZERO 
XI 2( 2) =ZERO 
XI 2 ( 3 ) =CX 
XI 2(4 ) =CX 
XI 2 ( 5 ) =ZERO 

Y 1 2 ( 1 ) =ZER0 
Y 1 2 ( 2 ) =CY 
Y12(3)=CY 
Y1 2(4 ) =ZERO 
Y 1 2 ( 5 ) =ZERO 
TRACE DU CADRE 

CALL D 1 MSU J ( ZERO , CX, ZERO , CY , XMOD ) 

CALL D I MOB J ( ZERO , CX , ZERO , CY , XMOD ) 

CALL KTRACE ( XI 2, Y 1 2 , 5, XMOD ) 

C#**** TRACE DU NOM 

CALL KTEXTE (X, Y , 3 . ,3. , NAM, ANG, NC, XMOD) 

RETURN 

END 

! JOB^T * TCART^POO3yP9C0URA ,40, ( REST ) MISE EN BIBLOM DE TCART 
'COMMENT ETUDE =2895PN 1 4 1 P 

I COMMENT MISE EN BIBLOM DU SOUS-PROGRAMME TCART 
I L I M I T ( CORE , 50 ) , ( T I ME , 1 ) , ( SPD I SC , 50 ) , ( PAGES , 30 ) 

' F ° RTR sSBRi6T?NE°TCART ( KODE , CX , CY , L I B , NCL , I DATE , NCD , XMOD ) 

C#**** SOUS-PROGRAMME DE TRACE DE L EN-TETE ONERA 

C**#** KODE =1 SI EN-TETE TRACE PERPEND I CULA I REMENT A L AXE OX 

£##*** =0 Si* EN-TETE TRACE PARALLELEMENT A L AXE OX 

C***«* CX = DIMENSION EN MM SUIVANT L AXE DES ABSCISSES DE LA 

g:::: CY = [MMENsf ON EN MM SUIVANT L AXE DES ORDONNEES DE LA 

PLANCHE A rrr>a i DC 

LIB = TABLEAU HOLLERITH CONTENANT LE T1TRE A ECRIRE 
NCL = NOMBRE DE CARACTERES DU TITRE A ECRIRE 

SI NCL = 0 PAS D ECR1TURE . , * mrc 


l IDA TE= TABLEAU CONTENASi LES VALEURS NUMERIOUES DE LA DATE 
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c* * * * * 
c* # # # * 
c* * * * * 
c#*#*# ncd 
c* * * * * 


I DATE ( 1 )=NUMERO DU JOUR 
I DATE ( 2) =NUMERO DU MOIS 
I DATE ( 3) =NUMERO DE L ANNEE 
=0 SI PAS D ECRITURE DE DATE 


DIMENSION LIB! 1 ) , I DATE! 1 ) 

DIMENSION XMOD ( 44 ) 

DIMENSION X(2),Y(2), I ON C 3 ) , I PA ( 1 ) , S ( 1 ) 
DATA ION/ ‘0. N. E. R. A. 1 / , I PA/ ' PAGE ' / , S/ V 
MODIFICATION DE L EPAISSEUR DU TRAIT 
CALL KSTEP 11,1,4,1, XMOD ) 

c***** 


V 


IFIKODE. EQ. 1 ) GO TO 130 

C**#** TRACE DE L EN-TETE PARALLELEMENT A L AXE OX DU TRACEUR 
X ( 1 ) =20. 

X ( 2 ) =X ( 1 ) 

Y ( t ) =0 . 

Y ( 2 ) =CY 

CALL KTRACEIX, Y, 2, XMOD) 

X ( 2 ) =CX 
Y ( 1 ) = (CY-20. ) 

Y ( 2 ) =Y 1 1 ) 

CALL K TRACE ( X, Y, 2, XMOD ) 

XC 1 ) =53 . 

X ( 2 ) =X ( 1 ) 

Y ( 1 ) = ( CY-20 . ) 

Y ( 2 ) =CY 

CALL K TRACE ( X, Y , 2, XMOD ) 

X( 1 )=(CX-30. ) 

X ( 2 ) =X ( 1 ) 

CALL KTRACEIX, Y, 2, XMOD) 

X( 1 ) =53. 

X ( 2 ) = CX 
Y ( 1 ) = ( CY- 1 3 . ) 

YC2)=Y( 1 ) 

CALL KTRACE ( X, Y , 2, XMOD ) 

C*»**» ECRITURE ONERA ET PAGE 
XA=21 . 

YA= ( CY -15. ) 

CALL KTEXTE (XA, YAj 3 . , 1 0 . , I ON, 0 . , IOjXMOD) 

XA= ( CX-28 . ) 

YA= ( CY -10. ) 

CALL KTEXTEIXA, YAj 3. , 3 . , I PA, 0. , 4, XMOD) 

C* * * * * ECRITURE EVENTUELLE DU TITRE 
I F ( NCL . EQ . 0 ) GO TO 120 
HX = 3 . 

100 CONTINUE 

XLON=HX*NCL 

XA=CX-83. 

IFCXLON. LT. XA) GO TO 110 
HX=HX-0 . 5 

IFCHX.LE.O. ) GO TO 120 
GO TO 100 
1 10 CONTINUE 

XA= (XA-XLON) /2. 

XA= (53. +XA) 

YA= ( CY - 1 9 . ) 

CALL KTEXTE C XA , YA, HX, 3. , LIB, 0. , NCL, XMOD) 

120 CONTINUE 

C* * * * * ECRITURE EVENTUELLE DE LA DATE 



IF(NCD. EQ. 0) CALL KSTEP< 1 , 1 , 1 , 1 ,XMOD) ; RETURN 
XA= ( CX-29 . ) 

YA= ( CY - 1 8 ) 

CALL KFIXE(XA, YA, 3. ,3. , I DATE( 11,0., +2, XMOD) 
XA=XA+7 . 

CALL KTEXTE(XA, YA, 3 . , 3. , S, 0. , 1 , XliOD) 


XA=XA+4 . „ 

CALL KFIXE(XA, YA, 3. , 3. . IDATEC2) , 0. , +2, XMOD) 
XA=XA+7. 

CALL KTEXTE ( XA , Y A , 3 . ,3. ,S,0. , 1,XM0D) 

XA"XA+4 

CALL Kf1xE(XA, YA, 3. , 3. , I DATE ( 3 ) , 0 . , +2, XMOD) 
CALL KSTEP< 1 , 1 , 1 , 1 ,XMOD) 

RETURN 

TRACE DE L EN-TETE PERPEND I CULAI REMENT A L 
130 CONTINUE 
X( 1 ) =0. 


X ( 2 ) =CX 
Y ( 1 ) = C CY -20 . ) 

Y ( 2 ) =Y ( 1 ) 

CALL KTRACE ( X , Y , 2 , XMOD ) 
XI 1 ) = ( CX-20 . ) 

X ( 2 ) =X ( 1 ) 


AXE OX DU TRACEUR 


Y ( 1 ) =0 . 

CALL KTRACE (X, Y, 2, XMOD) 

X ( 2 ) =CX 
Y ( 1 ) = ( CY -53 . ) 

Y ( 2) =Y ( 1 ) 

CALL KTRACE ( X , Y , 2 , XMOD ) 

Y ( 1 ) =30 . 

Y(2)=Y( 1 ) 

CALL KTRACEIX, Y, 2, XMOD) 

X( 1 ) = ( CX- 1 3 . ) 

X ( 2 ) =X ( 1 ) 

Y ( 1 ) =0 . 

Y(2)= (CY-53. ) 

CALL KTRACE ( X, Y , 2, XMOD ) 

C***** ECRITURE ONERA ET PAGE 
XAMCX-15. ) 

YA= ( CY - 21 . ) 

CALL KTEXTEIXA, YA, 3. , 1 0. , ION, 270. , 10, XMOD) 
XA= (CX-10. ) 


CALL KTEXTE (XA, YA, 3. , 3. , I PA, 270. , 4, XMOD) 
ECRITURE EVENTUELLE DU TITRE 
IFCNCL.EQ.O) GO TO 220 
HY = 3 , 

200 CONTINUE 

YL.ON = HY*NCL 
YA=CY -83 . 

IF(YLON.LT.YA) GO TO 210 
HY=HY -0 . 5 

IFCHY.LE.O.) GO TO 220 
GO TO 200 
210 CONTINUE 

XA= ( CX- 1 9 . ) 

YA= ( YA-YLON ) /2 . 

YA=( CY-53. -YA) 

CALL KTEXTE (XA, YA, HY, 3. , LIB, 270. ,NCL,XMOD) 
220 CONTINUE 


ECRITURE EVENTUELLE DE LA DATE 
IE(NCD.EG.O) CALL KSTEPC 1,1,1,!, XMOD) ; RETURN 
XA= ( CX- 1 8 . ) 

YA=29 . 

CALL KFI XE( XA, YA, 3 . ,3, , I DATEC 1 ) , 270. , +2, XMOD) 

YA=YA-7. 

CALL KTEXTE(XA, YA, 3. ,3. ,3,270. , 1,XM0D) 

YA=YA-4. 

CALL KFIXE(XA, YA, 3. ,3. , I DATE ( 2 ) , 270 . , +2, XMOD ) 

YA=YA-7 . 

CALL KTEXTEtXA, YA, 3. , 3. ,S, 270. , 1 ,XMOD) 

YA=YA-4. 

CALL KF I XE ( XA, YA, 3 . ,3. , I DATE ( 3 ) , 270 . , +2, XMOD) 

CALL KSTEP ( 1 , t , 1 , 1 , XMOD) 

RETURN 

END 

I EXEC I NOMB, XKEY = TCART 

! JOB, T TDEC, P003, P9C0URA, 40, (REST) MISE EN BIBLOM DE TDECB 
! COMMENT ETUDE=2895PN1 4 1 P 

I COMMENT MISE EN BIBLOM DE TDECB: TRACE DES COURBES AVANT LISSAOE 
ILIMIT (CORE, 50), (TIME, 1 ), <SPDISC,50), (PAGES, 49) 

I EXEC DLOM, %KEY = T0ECB 
I FORTRAN S I , LS, GO 

SUBROUT I NE TDECB ( KPLANC, DECB , ANGLES , FREQ, NFREQ, M I KEA, M I KEB , 

1 I T I T , NCAR , XMOD ) 
c* * * # * 

c***«* SOUS -PROGRAMME DE TRACE DES COURBES DECB=F( ANGLES) 
c* * * * * 

REAL*8 DECB( 130, 35 ), ANGLES ( 1 30 ) , FREQ ( 33) 

COMMON / I DENT /NPOI , KM I C 

COMMON /Tl TRE/LI B( 1 0) , I DATE( 3) , DB 1 ( 8, 4 ) , I PI ( 8) 

DIMENSION I T I T ( 1 ) , XM0D( 1 ) 

C*»*K* 

DIMENSION SANG( 130) 

D I MENS I ON NAM ( 7 ) , NASA ( 5 ) , I PO I NT ( 2 ) , I X ( 1 ) , I Y ( 1 ) , NM I C ( 2 ) , I DEG ( 1 ) 
DIMENSION MI CRO ( 4 ) , MO I NS ( 1 ) 

DIMENSION 1 ANG ( 4 ) , X I ANG ( 8 ) , I 5DB( 1 ) , I FREQ( 2) , I A( 1 ) , I HZ( 1 ) 
DIMENSION X12(2),Y12(2) 

DIMENSION D IFF (130) 

D I MENS ION NTR( 15), NEP( 15), NPL (15) 

DATA CX/300. /, CY/21 0 . / 

DATA NAM/ ' PA- J . BRASSEUR PR0G.N0ISE3 '/ 

DATA NASA/ ' N . A . S . A . /O . N . E . R . A . V 

DATA IPOINT/ 'POINT */,lX/’X= '/,IY/'Y= V.NMIC/’ MICRO= '/ 

DATA IANG/50, 90, 130, 170/ 

DATA XI ANG/ 13. ,43. , 73 . , 1 03 . , 1 53 . , 1 83 . ,213. ,243./ 

DATA I DEG/ 'DEG '/,I5DB/'5DB 1 / , I FREQ/ ‘ FREQ . '/ 

DATA MO I NS/'- '/,IHZ/'H2 V.IA/'A V 

DATA NTR/1 , 2, 3, 4 , 5, 1 , 2, 3, 4 , 5, 1 , 2, 3, 4 , 5/ 

DATA NEP/ 1 , 2, 1 , 1 , 1 , 1 , 2, 1 , 1 , 1 , 1 , 2, 1 , 1 , 1 / 

DATA NPL/ 1 , 1,1,1, 1,2, 2, 2, 2, 2, 3, 3, 3, 3, 3/ 

C***»* TRAI TEMENT D UNE LIGNE 
I L I GN= 1 

C***** INITIALISATION DES VALEURS X , Y , SANG ET MICRO 
120 CONTINUE 

I F ( I LION. EQ. 1 ) GO TO 140 
INITIALISATION DES VALEURS POUR LA LIGNE 2 
X=DB1 ( IPI (3) , 1 ) 

Y=DB1 ( IPI (3) , 2) 
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Ml CRO( 2) = I PI (7) 
M I CRO! 2 ) = I PI (8) 


DES VALEURS POUR LA LIGNE 1 


MI CROC 2) = 1 PI (5) 
M I CRO ( 2 ) = I P I (8) 


DO 130 I = 1 , MI KEB 
SANG( I ) =SNGL( ANGLES! 1 +MIKEA) ) 

DIFF! I ) = SNGL ( DECB ( I +MIKEA, 34 ) ) 

130 CONTINUE 

NBPT=MIKEB 

I F ( KM I C . EQ . 1 ) MICRO! 1 )“IPI (3) 

I F ( KM I C . EQ . 2 ) MICRO! 1 ) = IPI !4) 

MICRO! 1 )=IPI (3) 

MI CRO! 2) = I PI (7) 

MI CRO! 3) = l PI (4) 

M l CRO ( 4 ) = I P I (8) 

GO TO 160 

C*w*»* INITIALISATION 
140 CONTINUE 

X = DB1 ( IPI !1) , 1 ) 

Y = DB1 ! I PI ! 1 ) j 2) 

DO 150 1=1 , M I KEA 
SANG! I ) =SNGL! ANGLES! I ) ) 

DIFF! I ) =SNGL!DECB! 1,34)) 

150 CONTINUE 

NBPT = MI KEA 

I F ! KM I C . EQ . 1 ) MI CRO ! 1 ) = I P I ( 1 ) 

I F(KMI C . EQ. 2) MI CRO! 1 ) = I PI ! 2) 

MICRO! 1 ) = I P I l 1 ) 

MI CRO! 2) = I PI (5) 

MI CRO! 3) = I PI (2) 

M I CRO ! 4 ) = I P I 16) 

C****# NOMBRE DE FREQUENCES PAR LIGNE 
160 CONTINUE 

CALL M I NMAX (DIFF, NBPT , 1 , DM I N , DMAX , XMOD ) 

I DMAX= ( DMAX/ 1 0 . )+1 
I DMAX= I DMAX* 1 0 
I DM I N* I DMAX -70 
DMAX= I DMAX 
DMI N= I DMI N 

I F ( NFREQ . GT . 25 ) GO TO 170 
I FD= 1 

I FF=NFREQ 
GO TO 100 
170 CONTINUE 
1 FD= 1 
I FF=25 

C#*##* TRACE DU CADRE ET DU CARTOUCHE 
180 CONTINUE 
XT =10. 

YT = 200 . 

ANG=0 . 

NC = 28 

CALL TPL ( CX , CY , XT , Y T , ANG , NAM , NC , XMOD ) 

KODE= 1 
NCL=40 
NC= 1 

CALL TCART ( KODE, CX, CY, LIB, NCL , I DATE, NC, XMOD ) 
KPLANC-KPLANC+1 

C***** ECR1TURE NASA ET TITRE LU SUR CARTE 
XT = CX - 1 0 . 

YT = CY -55 . 

HL = 3 . 


HH = 5 . 
ANG=270. 


; GO TO 160 
; GO TO 160 


; GO TO 160 
; GO TO 160 
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NC= 1 9 

CALL KSTEP C 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTECXT, YT, HL, HH, NASA, ANG, NC, XMOD) 
CALL KSTEP ( 1 , 1,1, l,XMOD) 

C* * ** * 

XT =10. 

YT = 1 80 . 

HH = 3. 

ANG=0 . 

CALL KTEXTE ( XT , YT, HL, HH, I T! T, ANG, NCAR, XMOD) 
C* * # # * ECRITURE DE NPOI, X, Y ET KMIC 
XT= 1 0 . 

YT = 1 70 . 

NC = 6 

CALL KTEXTE ( XT , YT , HL, HH, I POINT, ANG, NC, XMOD) 
XT=XT +18. 

NC=4 

CALL KF I XE ( XT , YT, HL, HH, NPOI , ANG, NC, XMOD) 
XT=XT + 20 . 

NC = 2 

CALL KTEXTE ( XT, YT, HL, HH, IX, ANG, NC, XMOD) 

XT = XT + 6 . 

NC=5 

CALL KDECIMCXT , YT, HL, HH, X, ANG, NC, XMOD) 

XT = XT +23 . 

NC = 2 

CALL KTEXTE ( XT , YT, HL, HH, I Y, ANG, NC, XMOD) 

XT = XT + 6 . 

NC = 5 

CALL KDECI M(XT, YT, HL, HH, Y,ANG, NC,XMOD) 

XT=XT +23 . 

NC = 6 

CALL KTEXTE (XT, YT, HL, HH, NMI C, ANG, NC,XMOD) 

XT = XT + 27 . 

NC= 1 

CALL KF I XE ( XT , YT, HL, HH, MI CROC 1 ) , ANG, NC, XMOD) 
XT=XT + 6 . 

CALL KTEXTE ( XT , YT, HL, HH, MOI NS, ANG, NC, XMOD) 
XT=XT + 6 , 

CALL KFI XECXT, YT, HL, HH, MI CROC 2) , ANG, NC, XMOD) 
l FCKMI C. NE. 0) GO TO 190 
XT = XT +6 . 

CALL KTEXTECXT , YT , HL, HH, MOI NS, ANG, NC, XMOD) 
XT=XT +6 . 

CALL KFI XECXT, YT, HL, HH, M I CRO ( 3 ) , ANG , NC,XMOD) 
XT=XT+6. 

CALL KTEXTECXT, YT, HL, HH, MOI NS, ANG, NC,XM0D) 

XT = XT + 6 . 

CALL KF I XE ( XT , YT , HL , HH , M I CRO C 4 ) , ANG , NC , XMOD ) 
190 CONTINUE 

C»**** ECRITURE ‘FREQ. A 1 

XT = 20 . 

YT = 1 55 . 

NC = 5 

CALL KTEXTECXT, YT, HL, HH, I FREQ, ANG , NC , XMOD ) 

XT = XT +42 . 

NC= 1 

CALL KTEXTECXT, YT, HL, HH, I A , ANG , NC , XMOD ) 

XT = XT + 30 . 

NC = 2 



CALL KTEXTECXT, YT, HL, HH, I HZ, ANG, NC, XMOD) 


C*s*** 

XT = 1 60 . 

NC = 5 

CALL KTEXTE(XT, YT, HL, HH, I FREQ, ANG, NC, XMOD) 

XT = XT +42 . 

NC= 1 

CALL KTEXTECXT, YT, HL, HH, I A, ANG, NC, XMOD) 

XT = XT + 30 . 

NC = 2 

CALL KTEXTECXT, YT, HL, HH, I HZ, ANG, NC, XMOD) 

C*s*** TRACE DU PREMIER AXE VERTICAL 
XT =10, 

YT =10. 

NC = 0 

PASMM= 1 0 . 

ANG=90 . 

XMI N=1 . 

PAS= 1 . 

NGRAD= 1 5 

CALL KAXE ( XT , YT , NORD , NC , PASMM , ANG , XM I N , PAS , NGRAD , NF , XMOD ) 
C***s* TRACE DU SECOND AXE VERTICAL 
XT = 1 50 . 

YT= 1 0 . 

CALL°KAXE ( XT , Y T , NORD , NC , PASMM , ANG , XM I N , PAS , NGRAD , NF , XMOD ) 
C****s TRACE PREMIER AXE HOR I ZONTAL ( PART I E GAUCHE DE LA PLANCHE) 
XT =10. 

YT =10, 

PASMM =7. 5 
ANG=0 . 

CALL°KAXE C XT , YT , NORD , NC , PASMM , ANG , XM I N , PAS , NGRAD, NF , XMOD ) 
C* * * * * TRACE PREMIER AXE HOR I ZONTAL ( PART I E DROITE DE LA PLANCHE) 
XT = 1 50 . 

CALL°KAXE(XT, YT, NORD, NC, PASMM, ANG, XM I N, PAS, NGRAD, NF, XMOD) 
C***** ECRITURE DES COTATIONS SUR LES AXES HORIZONTAUX 
Y,T = 5 , 

HL=2 . 

HH = 3 . 

NC=3 

DO 200 1=1,4 
XT=X I ANG ( I ) 

CALL KFIXEIXT, YT.HL, HH, I ANG( I ) , ANG, NC.XMOD) 

200 CONTINUE 
XT = XT + 10. 

NC = 3 

CALL KTEXTECXT, YT, HL, HH, I DEG, ANG, NC, XMOD) 


C****s 

YT = 5 . 

DO 210 1=1,4 
XT = XI ANG( I +4) 

CALL KFIXEIXT, YT, HL, HH, I ANG( I ), ANG, NC, XMOD) 
210 CONTINUE 
XT = XT +10. 

NC=3 

CALL KTEXTECXT, YT, HL, HH, I DEG, ANG, NC, XMOD) 
Csss * * ECRITURE 2DB 


143 


XT = 8 . 

YT = 1 42 . 

HH=2 . 

ANG=90 . 

NC=3 

CALL KTEXTE ( XT, YT, HL, HH, ! 5DB, ANG, NC , XMOD) 

XT = 1 48 , 

YT= 1 42 . 

CALL KTEXTE(XT, YT, HL, HH, 1 5DB , ANG , NC, XMOD) 
C***** ECRITURE DES VALEURS MAX 
XT =12. 

YT= 1 50 . 

HH = 2 . 

HL = 2 . 

ANG=0 . 

NC=5 

CALL KDEC I M ( XT , YT , HL , HH , DMAX , ANG , NC , XMOD ) 

XT = 1 52 . 

CALL KDEC I MCXT, YT, HL, HH, DMAX, ANG, NC, XMOD) 
C***** ECRITURE DES FREQUENCES 
XT=38 . 

YT = 1 55 , 

NC=7 
HL = 3 . 

HH = 3. 

ANG=0 . 

SFREQ=SNGL ( FREQ ( I FD ) ) 

CALL KDECI M< XT, YT, HL, HH, SFREQ, ANG, NC, XMOD) 

I F< < l FD + 9 ) , GE . IFF) GO TO 240 
SFREQ=SNGL ( FREQ( I FD+9) ) 

XT=XT + 30 . 

CALL KDEC I M ( XT , YT , HL , HH , SFREQ, ANG, NC, XMOD ) 

C* * * * * 

XT = 1 78 , 

SFREQ=SNQL ( FREQ ( I FD+ 1 0 ) ) 

CALL KDEC I M ( XT, YT, HL, HH, SFREQ, ANG, NC, XMOD) 
240 CONTINUE 
XT -XT + 30 , 

SFREQ=SNQL ( FREQ (IFF)) 

CALL KDEC I M( XT, YT, HL, HH, SFREQ, ANG, NC,XMOD) 
C***** TRACE DES COURBES 
CXSUJ 1 = 40 . 

CXSUJ2= 1 70 . 

CYSUJ 1 = DMI N 
CYSUJ2=DMAX 
CX0BJ1 =10. 

CX0BJ2= 1 07 . 5 
CYOBJ 1=10, 

CY0BJ2= 1 50 . 

I DEB= I FD 

I F ( IFF. GT . ( I FD+9 ) ) GO TO 280 
I FI N= I FF 
GO TO 290 
280 CONTINUE 

I F I N= I FD+9 
290 CONTINUE 
C# * # # * 

CALL DEPLAC ( 0 . , XMOD ) 

CALL DIMSUJ C CXSUJ 1 , CXSUJ2, CYSUJ 1 , CYSUJ2, XMOD) 
CALL DIMOBJ ( CX0BJ1 , CX0BJ2, CYOBJ 1 , CY0BJ2, XMOD) 


144 



K = 0 

DO 340 I = I DEB, I FI N 
I F( I LION . EQ. 1 ) GO TO 310 

C* * ** * 

DO 300 J=1 , MI KEB 

DI FF( J ) =SN0L ( DECB ( J +M IKEA, I ) ) 

300 CONTINUE 
GO TO 330 

o* * * # # 

310 CONTINUE 

DO 320 J=1 j M I KEA 
D I FF C J ) =SNGL ( DECB ( J j I ) ) 

320 CONTINUE 

c* * * * * 

330 CONTINUE 
K = K + 1 

I F ( K . GT .15) WRI TE( 1 08, 500) ; RETURN 
CALL KSTEP( 1 , NTR(K) , NEP(K) , NPL ( K ) , XMOD) 
CALL KTRACE(SANG, Dt FF, NBPT, XMOD) 

340 CONTINUE 
o* * * * * 

CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD ) 

IF( IFIN.EQ. IFF) GO TO 350 
I DEB= I F I N+ 1 
1 F I N= I FF 
CXOB J 1=1 50 . 

CX0BJ2=247. 5 
GO TO 290 

C* * * * * 

350 CONTINUE 

I F ( IFF. EQ. NFREQ) GO TO 360 
I FD= I FF + 1 
I FF=NFREQ 

PP V - py +on 

CALL DEPLAC( CCX, XMOD) 

GO TO 180 
360 CONTINUE 

I L I GN= I L I GN+ 1 
pp y -py+?n 

CALL DEPLACC CCX, XMOD) 

IFCILIGN.LE.2) GO TO 120 


C * * * * * 

RETURN 

500 FORMAT (IX,' TROP DE COURBES 1/3 OCTAVES '//) 

END 

I EXEC I NOMB, 5SKEY = TDECB 

! JOB , T TD I F, P003, P9C0URA, 40, ( REST) MISE EN BIBLOM DE TDIFF 
! COMMENT ETUDE=2895PN1 4 1 P 

I COMMENT MISE EN BIBLOM DE TDIFF: TRACE DES COURBES DE DIFFERENCE 
ILIMIT (CORE, 50), (TIME, 1 ), (SPD!SC,50), (PAGES, 49) 

I EXEC DLOM, %KEY = TDI FF 

I FORTRAN S I , LS, GO „ 

SUBROUTINE TD I FF ( KPLANO, DECB , ANGLES, FREQ, NFREQ, M I KEA, M I KEB , 
1 I T I T , NCAR , XMOD ) 
c * # * * * 

c***** SOUS -PROGRAMME DE TRACE DES DIFFERENCES 


REAL *8 DECB ( 130,35), ANGLES ( 130), FREQ ( 33) 
REAL*8 DECBS 

COMMON /D0NTD/ DECBS ( 130, 35 ) 
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COMMON / [ DENT/NPOI , KM I C 

COMMON /TITRE/LIBC 10), IDATE(3),DB1 (8,4), I PI (8) 

DIMENSION ITIT(1 ) J XM0D(1 ) 

C***** 

DIMENSION SFREQ ( 33 ) , SANG ( 1 30 ) 

DIMENSION NAM ( 7 ) , NASA ( 5 ) , I PO I NT ( 2 ) , I X ( 1 ) , I Y ( 1 ) , NM I C ( 2 ) , I DEGC 1 ) 
D I MENS ION Ml CRO ( 4 ) , MO I NS ( 1 ) 

D I MENS I ON I ANG ( 4 ) , X I ANG ( 8 ) , I 2DB ( 1 ) , I FREQ ( 1 ) 

DIMENSION X12(2),Y12(2) 

DIMENSION DI FF( 1 30) 

c* * * * * 

DATA CX/300. /, CY/21 0. / 

DATA NAM/ 1 PA- J . BRASSEUR PROG . NO I SE3 '/ 

DATA NASA/ ' N. A . S. A. /0. N. E. R. A . V 

DATA I POI NT/ ' POI NT , /,IX/'X= , /,IY/'Y= V.NMIC/’ MICR0= V 

DATA IANG/50, 90, 130, 170/ 

DATA XI ANG/ 1 3 . , 43 . ,73. , 103, , 153. , 183. ,213. , 243. / 

DATA I DEG/ DEG V,I2DB/'2DB ' / , I FREQ/ ' FREQ ' / 

DATA MO I NS/ ’ - V 

C* * * a * CALCUL DES DIFFERENCES EN DOUBLE PRECISION 
DO 100 J=1 , 130 
DO 100 1=1,35 

DECBS( J, I ) =DECBS ( J , I ) - DECB ( J , I ) 

100 CONTINUE 

CONVERSION DES FREQUENCES EN SIMPLE PRECISION 
DO 110 I = 1 , 33 
SFREQ ( I ) =SNGL ( FREQ ( I ) ) 

1 10 CONTINUE 

C****« TRA I TEMENT D UNE L I GNE 
I L I GN= 1 

C* * * * * INITIALISATION DES VALEURS X , Y , SANG ET MICRO 
120 CONTINUE 

I F ( ILIGN. EQ. 1 ) GO TO 140 

C* * * * * INITIALISATION DES VALEURS POUR LA LI GNE 2 
X = DB1 (I PI (3) , 1 ) 

Y=DB1 C IPI (3), 2) 

DO 130 I = 1 , M I KEB 

SANG ( I ) =SNGL ( ANGLES ( I +MI KEA ) ) 

130 CONTINUE 
NBPT=MIKEB 

IFCKMIC. EQ. 1 ) MI CROC 1 ) = I PI (3) ; M I CRO ( 2 ) = I P I ( 7 ) ; GO TO 160 
IF(KMIC. EQ. 2) Ml CROC 1 ) r I PI (4 ) ; M I CRO ( 2 ) = I P I ( 8 ) : GO TO 160 
MI CROC 1 ) = I P I (3) 

M I CRO ( 2 ) = I P I (7) 

MI CRO ( 3) = I PI (4) 

M I CRO ( 4 ) = I P I (8) 

GO TO 160 

C* * * * * INITIALISATION DES VALEURS POUR LA LI GNE 1 
140 CONTINUE 

X = DB 1 ( IPI ( 1 ) , 1 ) 

Y = DB1 ( I PI ( 1 ) , 2) 

DO 150 1=1, Ml KEA 

SANG ( I ) =SNGL ( ANGLES ( 1 ) ) 

150 CONTINUE 
NBPT = M I KEA 

IFCKMIC. EQ. 1 ) MI CROC 1 ) = I PI ( 1 ) ; M I CRO ( 2) = I PI ( 5 ) ; GO TO 160 
IFCKMIC. EQ. 2) M I CRO ( 1 ) = I P I ( 2 ) ; M I CRO ( 2 ) = I PI ( 6) ; GO TO 160 
MICR0C1 )=IPI (1 ) 

M I CRO C 2 ) = I P I (5) 

MI CROC 3) = I PI (2) 
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M I CRO (4 ) = I PI (6) 

C****» NOMBRE DE FREQUENCES PAR LIGNE 
160 CONTINUE 

I F ( NFREQ . GT . 25) GO TO 170 
I FD= 1 
I FF=NFREQ 
GO TO 180 
170 CONTINUE 
I FD= 1 
I FF = 25 

C**#** TRACE DU CADRE ET DU CARTOUCHE 
180 CONTINUE 
XT =10. 

YT=200. 

ANG=0 . 

NC = 28 

CALL TPLCCX, CY , XT, YT, ANG, NAM, NC,XMOD) 

KODE= 1 
NCL=40 
NC= 1 

CALL TCART ( KODE , CX , CY , L I B , NCL , I DATE, NC. XMOD) 
KPLANC=KPLANC+ 1 

C***** ECRITURE NASA ET T1TRE LU SUR CARTE 
XT=CX- 1 0 . 

YT = CY -55 . 

HL = 3 . 

HH = 5. 

ANG=270 . 

NC= 1 9 

CALL KSTEP ( 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTE (XT, YT,HL, HH, NASA, ANG, NC, XMOD) 
CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD) 

c# * # * * 

XT =10. 

YT= 1 80 . 

HH = 3. 

ANG=0 . 

CALL KTEXTE ( XT, YT, HL, HH, I TI T, ANG, NCAR, XMOD) 
C****# ECRITURE DE NPOI, X, Y ET KMIC 
XT =10. 

YT= 1 70 , 

NC = 6 

CALL KTEXTE ( XT , YT , HL , HH , 1 PO I NT , ANG , NC , XMOD ) 
XT = XT +18. 

NC = 4 

CALL KFI XE(XT, YT, HL, HH, NPOI , ANG, NC, XMOD) 

XT = XT + 20 . 

NC = 2 

CALL KTEXTE(XT,YT, HL, HH, I X , ANG, NC, XMOD ) 

XT = XT + 6 . 

NC = 5 

CALL KDEC I M( XT, YT, HL, HH, X, ANG, NC,XMOD) 

XT = XT + 23 . 

NC = 2 

CALL KTEXTE (XT, YT, HL, HH, I Y , ANG , NC , XMOD ) 

XT = XT +6 . 

NC = 5 

CALL KDEC I M( XT, YT, HL, HH, Y , ANG, NC, XMOD ) 

XT = XT + 23 . 

NC = 8 
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CALL KTEXTE ( XT, YT, HL, HH, NMI C, ANG, NC, XMOD) 

XT = XT + 27 . 

NC = 1 

CALL KFI XE(XT, YT, HL, HH, MI CRO Cl), ANG, NC, XMOD) 

XT = XT + 6 . 

CALL KTEXTE(XT, YT, HL, HH, MO I NS, ANG, NC,XMOD) 

XT = XT + 6 . 

CALL KFIXE(XT, YT, HL, HH J MICR0(2) , ANG, NC,XMOD) 

IF(KMIC.NE.O) GO TO 190 
XT=XT + 6 . 

CALL KTEXTE ( XT , YT , HL , HH, MO I NS, ANG , NC, XMOD ) 

XT = XT + 6 . 

CALL KF I XE ( XT, YT, HL , HH, M I CRO ( 3 ) , ANG , NC , XMOD ) 

XT=XT + 6 . 

CALL KTEXTE ( XT, YT , HL, HH, MO I NS, ANG, NC, XMOD) 

XT=XT +6 . 

CALL KFIXE(XT, YT, HL, HH, MI CRO (4 ) , ANG, NC,XMOD) 

190 CONTINUE 

Cxxxxx TRACE DU PREMIER AXE VERTICAL 
XT =10. 

YT =40 . 

NC = 0 

PASMM= 1 0 . 

ANG=90 . 

XM I N= 1 . 

PAS= 1 . 

NGRAD=1 1 
NF = 0 

CALL KAXE ( XT , Y T , NORD , NC , PASMM , ANG , XM I N , PAS , NGRAD , NF , XMOD ) 
C**»x* TRACE DU SECOND AXE VERTICAL 
XT = 1 50 . 

YT= 1 0 . 

NGRAD= 1 6 

CALL KAXE ( XT , Y T , NORD , NC , PASMM , ANG , XM I N , PAS , NGRAD , NF , XMOD ) 
C***x* TRACE PREMIER AXE HOR I ZONTAL ( PART I E GAUCHE DE LA PLANCHE ) 
XT =10. 

YT=45 . 

PASMM =7, 5 
ANG=0 . 

NGRAD= 1 4 

CALL KAXE (XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
Cxxxxx TRACE PREMIER AXE HOR I ZONTAL ( PART I E DROITE DE LA PLANCHE) 
XT = 1 50 , 

YT= 1 5 . 

CALL KAXE (XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
C**#** ECRITURE DES COTATIONS SUR LES AXES HORIZONTAUX 
YT = 35 . 

HL = 2 . 

HH= 3 . 

NC = 3 

DO 200 1=1,4 
XT = X I ANG ( I ) 

CALL KF I XE ( XT, YT, HL , HH, I ANG ( I ) , ANG , NC , XMOD ) 

200 CONTINUE 
XT = XT +10. 

NC = 3 

CALL KTEXTE(XT, YT, HL, HH, I DEG , ANG, NC, XMOD ) 

C# x x * x 

YT = 5 . 

DO 210 1=1,4 
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XT = X I ANG ( I +4 ) „ 

CALL KFI XE(XT, YT, HL, HH, I ANGC I ) , ANG, NC.XMOD) 

210 CONTINUE 
XT = XT + 10. 

NC = 3 

CALL KTEXTE (XT, YT , HL., HH, 1 DEG, ANG, NC, XMOD) 
C***»* ECRITURE 2DB 
XT = 8. 

YT = 1 32 . 

HH = 2 . 

ANG=90. 

NC = 3 

CALL KTEXTE (XT, YT, HL, HH, I 2DB , ANG , NC , XMOD ) 

XT =148. 

CALL KTEXTE ( XT, YT, HL, HH, I 2DB, ANG, NCj XMOD) 

C* **** TRACE DES AUTRES AXES 
XI 2 ( 1 ) = 10. 

XI 2 ( 2 ) = 1 07 . 5 
Y 1 2 ( 1 ) =45 . 

DO 220 1=1,9 
Y12( 1 )=Y12( 1 )+10. 

Y12(2)=Y12( 1 ) 

CALL KTRACE(X12,Y12,2, XMOD ) 

220 CONTINUE 
C***** 

XI 2( 1 ) = 1 50 . 

XI 2(2) =247. 5 
Y 1 2 ( 1 ) = 1 5 . 

DO 230 1=1,14 
Y 1 2 ( 1 ) =Y 1 2 ( 1 )+10. 

Y12(2)=Y12( 1 ) 

CALL KTRACE ( X 1 2, Y 1 2 , 2 , XMOD ) 

230 CONTINUE 

ECRITURE DES FREQUENCES EN BOUT D AXE 
YT=45 . 

XT =11 1 . 

HL=2 . 

HH = 2 . 

ANG=0 . 

NC = 7 

DO 240 l = I FD, I FD+9 
I Ft I .GT, IFF) GO TO 260 

CALL KDECIM(XT,YT,HL,HH,SFREQ( I), ANG, NC.XMOD) 

YT = YT +10. 

240 CONTINUE 
YT=YT-5. 

NC = 4 

CALL KTEXTE ( XT, YT, HL, HH, I FREQ, ANG, NC.XMOD) 

c* * # * # 

XT = 251 . 

YT =15. 

NC = 7 

DO 250 I = I FD+ 1 Oj IFF 

CALL KDECIMCXT.YT.HL.HH.SFREQC I ) , ANQ , NC , XMOD ) 
YT = YT + 10. 

250 CONTINUE 
YT = YT-5 . 

NC = 4 

CALL KTEXTE (XT, YT, HL, HH, 1 FREQ, ANG, NC, XMOD) 


GO TO 270 
260 CONTINUE 
YT=YT-5. 

NC = 4 

CALL KTEXTECXT, YT.HL.HH, I FREQ, ANG , NC , XMOD ) 
270 CONTINUE 

C* * * * * TRACE DES COURBES DE DIFFERENCES 
CXSUJ1 =40. 

CXSUJ2= 1 70 , 

CYSUJ 1 = - 1 . 

CYSUJ2= + 1 . 

CXOB J 1=10. 

CXOB J2= 1 07 . 5 
CY0BJ1 =30. 

CY0BJ2=40 . 

I DEB= I FD 

I F ( IFF.GT. ( IFD+9) ) GO TO 280 
I F I N= I FF 
GO TO 290 
280 CONTINUE 

I F I N= I FD+9 
290 CONTINUE 
C# * * * * 

DO 340 I = I DEB j IFIN 

IF( ILIGN.EQ. 1 ) GO TO 310 

C* * * * # 

DO 300 J=1 , M I KEB 

DIFF( J)=SNGL(DECBS( J+MIKEA, I ) ) 

300 CONTINUE 
GO TO 330 

0 * * * * * 

310 CONTINUE 

DO 320 J=1 , M I KEA 

DI FF ( J ) =SNGL ( DECBS ( J , I ) ) 

320 CONTINUE 
C ***** 

330 CONTINUE 

CYOB J 1 =CYOBJ 1+10. 

CYOB J2=CY0B J2+ 1 0 . 

CALL DEPLACCO. , XMOD) 

CALL D I MSU J ( CXSU J 1 , CXSUJ2 , CYSUJ 1 f CYSUJ2 , XMOD ) 
CALL D I MOB J ( CXOB J 1 J CX0BJ2, CY0BJ1 , CY0BJ2,XM0D) 
CALL KTRACE ( SANG , DI FF, NBPTj XMOD ) 

340 CONTINUE 
Cxoxx 

I F ( IFIN. EQ. IFF) GO TO 350 
I DEB= I F I N+ 1 
I FI N= IFF 
CXOB J 1 = 1 50 , 

CX0BJ2 = 247, 5 
CYOBJ 1=0. 

CY0BJ2= 1 0 . 

GO TO 290 

C* # * * * 

350 CONTINUE 

IF< IFF. EQ. NFREQ) GO TO 360 
I FD= I FF + 1 
I FF=NFREQ 
CCX=CX+20 . 

CALL DEPLAC ( CCX , XMOD ) 



GO TO 160 
360 CONTINUE 

I L I GN= I L I GN+ 1 
rrv = rx + 

CALL DEPLAC ( CCX , XMOD ) 

IF( I LION. LE. 2) 00 TO 120 


MISE EN BIBLOM DE TXSD 


DES COURBES 
(PAGES, 49) 


X/D=F< THETA-S) 


C* * * * * 

RETURN 
END 

I EXEC I NOMB , XKEY = TD I FF 
! JOB, T TXSD, P003, P9C0URA, 40, ( REST) 

! COMMENT ETUDE=2895PN 1 4 1 P 
I COMMENT MISE EN BIBLOM DE TXSD : TRACE 
I LI MI T (CORE, 50) , ( TIME, 1 ) , (SPDISC, 50) 

I EXEC DLOM, XKEY = TXSD 

SUBROUT I NE TXSDCKPLANC, XOVERD, THETAS, NTAB, NFREQ, XDMAX, 
1THETSM, RNZDI A, VJET , FREQ, LI B1 , LIB2, XMOD) 

C«**** SOUS -PROGRAMME DE TRACE DES COURBES X/D = F ( THETAS ) 

REAL*8 XOVERD (50, 33) , THETAS (50, 33 ) , XDMAX ( 33 ) , THETSM ( 33 ) 
RNZDIA, VJET, FREQ (33) 

/ I DENT /NPO I 

/TI TRE/LI B (10), I DATE( 3) 

/TABD/STR( 33) , DFMAX(33) , XPEAKN ( 33 ) , XPEAKF ( 33 ) 
STR, DFMAX, XPEAKN, XPEAKF 


REAL*8 

COMMON 

COMMON 

COMMON 

REAL*8 


DIMENSION XMOD ( 1 ) , NTAB ( 1 ) , LIB1 ( 1 > , LIB2( 1 ) 


Q # X # K X 

D I MENS I ON NAM ( 7 ) , NASA ( 5 ) , I PO I NT ( 2 ) , I DEG ( 1 ) 
DIMENSION I V ( 4 ) , IDIA(3), IST(1 ), I D I F ( 2 ) , I PEAK ( 3 ) 
D I MENS I ON I THE ( 2) , I XSD ( 1 ) , I FREQ ( 1 ) 

DIMENSION I ANG( 7) ,XIANG(7) , IVALX(6) 

DIMENSION SXSD(50) , STHETA( 50) 

DIMENSION IFIG(I) 

DIMENSION X12(2),Y12(2) 


I NEAR ( 1 ) , I FAR ( 1 ) 


c# # * * * 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 


^AM/ ' PA- J . BRASSEUR PR0G.N0ISE3 '/ 
vJASA/ 'N.A.S.A./O.N.E.R.A. ' / 

[POINT/ ‘POINT '/ 

I DEG/' DEG '/ 

IV/ ‘ VJET C FT /SEC ) = V , _ ^ 

IDIA/'DIA. (FT)= '/i I ST / 1 ST= ' / , I DI F/ DIF. MAX / 

I PEAK/ ' PEAK ( DEG . ) 7,1 NEAR/ 1 NEAR ‘ / , I FAR/ 1 FAR / 

| THE/ ' THETA-S 7,1 XSD/ ' X/D 7,1 FREQ/ ' FREQ * / 


r* * * * * * 

DATA CX/21 0 . / , CY/300 . / 

DATA I ANG/40, 60, 80, 1 00, 1 20, 1 40, 1 60/ 

DATA XIANG/47 . , 67 . , 87 . , 1 07 . , 1 27 . , 1 47 . , 1 67 . / 
DATA I VALX/O, 2, 4, 6, 8, 10/ 

DATA I FIG/ 1 FIG. '/ 


c* * * * * 

C*#*** TRACE DE 2 COURBES PAR PLANCHE 
NBCT=0 

DO 210 I F= 1 , NFREQ 
1 F(NTAB( I F) . EQ. 0) GO TO 210 
I F ( NBCT . EQ . 1 ) GO TO 160 
TRACE DU CADRE ET DU CARTOUCHE 
IF (NBCT. EQ. 2) NBCT=0 
XT =10. 

YT= 1 0 . 

ANG=90 . 
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NC = 26 

CALL TPL ( CX , CY, XT, YT, ANG, NAM, NC, XMOD) 

K0DE=0 
NCL=40 
NC= 1 

CALL TCART ( KODE, CX, CY, LI B, NCL, I DATE, NC, XMOD) 
KPLANC=KPLANC+ 1 
C**#** ECRITURE NASA 
XT = 55 . 

YT = CY - 1 0 . 

HL = 3 . 

HH=5 . 

ANG=0 . 

NC= 1 9 

CALL KSTEP ( 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTE ( XT , YT, HL, HH, NASA, ANG, NC, XMOD) 
CALL KSTEP (1 , 1 , 1 , 1 , XMOD ) 

C***** ECRITURE DANS LA MARGE DE LIB1 ET L I B2 
HL = 2 . 5 
HH = 2 . 5 
NC = 80 
ANG=90 , 

XT=6 . 5 
YT = 1 00 . 

CALL KTEXTE ( XT , YT , HL, HH, LI B1 , ANG, NC, XMOD) 

XT =16.5 

CALL KTEXTE ( XT, YT, HL, HH, LI B2, ANG, NC, XMOD) 
ECRITURE NPO I 
XT = 25 . 

YT=CY -28 . 

NC = 5 
HL = 3 . 

ANG=0 . 

HH = 3. 

CALL KTEXTE (XT , YT, HL, HH, I POI NT, ANG, NC, XMOD ) 

C* * * * * 

XT = XT +18. 

NC = 4 

CALL KFIXECXT, YT, HL, HH, NPO I , ANG, NC,XMOD) 
C»**** ECRITURE VJET 
XT = XT +18. 

NC= 1 3 

CALL KTEXTE ( XT, YT, HL, HH, I V, ANG, NC, XMOD) 

S=SNGL ( VJET ) 

XT = XT +42 . 

NC = 6 

CALL KDECIM( XT, YT, HL, HH, S, ANG, NC, XMOD) 

C* * # * # ECRITURE DE DIA.(FT) 

XT = XT + 24 . 

NC = 9 

CALL KTEXTE (XT, YT, HL, HH, I DI A, ANG, NC, XMOD) 

C* * * * * 

XT = XT + 30 , 

NC = 5 

S = SNGL ( RNZD I A ) 

CALL KDECIMIXT, YT, HL, HH, S, ANG, NC, XMOD) 

C****# ECRITURE DE FIG. 

XT = XT + 30 . 

NC = 4 
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CALL KTEXTE (XT, YT, HL, HH, I FI G, ANQ j NC, XMOD) 
C***** TRACE DU TABLEAU 
XI 2( 1 ) = 20 . 

XI 2( 2) =CX- 1 0 . 

Y 1 2 ( 1 ) =CY -45 . 

Y12(2)=Y12( 1 ) 

CALL KTRACE ( X 1 2 , Y 1 2 , 2 , XMOD ) 

XI 2( 1 )=18. 

Y 1 2 ( 1 ) =CY-60. 

Y1 2(2) =CY-35. 

DO 110 1=1,7 

XI 2 ( 1 ) =X 1 2 ( 1 ) +26 . 

XI 2 ( 2 ) =X1 2 ( 1 ) 

IFCI.EQ.4) 00 TO 100 

CALL KTRACE (X12,Y12, 2, XMOD ) 

GO TO 110 
100 CONTINUE 

Y1 2(2) =Y1 2( 2) -5. 

CALL KTRACE ( X 1 2 , Y 1 2 , 2 , XMOD ) 

Y 1 2 ( 2 ) =CY -35 . 

110 CONTINUE 

q**#** DIFFERENTES INSCRIPTIONS DU TABLEAU 
YT=CY-40. 

XT = 26 . 

ANG=0 . 

HL = 3 . 

HH = 3 . 

CALL KTEXTE(XT, YT, HL, HH, I FREQ, ANG, NC, XMOD) 

o* * * * * 

XT = 54 . 

NC = 2 

CALL KTEXTE (XT, YT, HL, HH, 1ST, ANG, NC, XMOD) 

c* * * * * 

XT = 72 . 

NC = 8 

CALL KTEXTE(XT, YT, HL, HH, I D I F, ANG, NC, XMOD ) 

C*** * * 

YT = YT + 2 . 

XT = 1 07 . 

CALL KTEXTE(XT, YT, HL, HH, I PEAK, ANG, NC, XMOD) 
YT = YT-5 . 

XT = 1 03 , 

CALL KTEXTE ( XT , Y T , HL , HH , I NEAR , ANG , NC , XMOD ) 
XT = 1 30 . 

NC = 3 

CALL KTEXTE ( XT, YT, HL, HH, I FAR, ANG, NC, XMOD) 

C* * * * * 

YT=CY -40 . 

XT=1 50. 

NC = 7 

CALL KTEXTE ( XT, YT, HL, HH, I THE, ANG, NC, XMOD) 

C** * * * 

XT = CX-28 . 

NC = 3 

CALL KTEXTE ( XT, YT, HL, HH, I XSD, ANG, NC, XMOD) 
C**#** TRACE DU PREMIER AXE VERT I CAL ( PART I E HAUTE 
XT = 40 . 


DE LA PLANCHE) 


YT= 1 30 . 

NC = 0 

PASMM=20 . 

ANG=90 . 

XM I N= 1 . 

PAS= 1 . 

NGRAD=6 
NF = 0 

CALL KAXE ( XT , YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD 
C ***** TRACE DU SECOND AXE VERT I CAL ( PARTI E BASSE DE LA 
YT =10. 

CALL KAXEfXT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD. 
C*»»** TRACE DU PREMIER AXE HORIZONTAL 
XT = 40 . 

YT = 1 30 . 

ANG=0 . 

PASMM = 1 0 . 

NGRAD = 1 5 

CALL KAXE ( XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, 
TRACE DU SECOND AXE HORIZONTAL 
YT =10. 

CALL KAXE (XT , YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, 
C*»»»* ECRITURE DES COTATIONS SUR LES AXES HORIZONTAUX 
YT = 5 . 

ANG=0 . 

HL = 2 . 

HH = 2 . 

NC = 3 

DO 120 1=1,7 
XT = X I ANG ( I ) 

CALL KFI XE(XT, YT, HL, HH, I ANG ( I ) , ANG, NC, XMOD) 

120 CONTINUE 
XT = XT +10. 

NC = 3 

CALL KTEXTE ( XT , YT, HL, HH, I DEG, ANG, NC, XMOD) 

YT =10. 

XT = 1 63 . 

NC = 7 

CALL KTEXTE ( XT, YT, HL, HH, I THE, ANG , NC, XMOD ) 

YT = 1 00 . 

XT = 60 . 

NC = 3 

CALL KTEXTE (XT, YT, HL, HH, I ST, ANG, NC, XMOD) 

C* * * * * 

YT= 1 25 . 

NC = 3 

DO 130 1=1,7 
XT = X I ANG ( I ) 

CALL KFI XECXT, YT, HL, HH, I ANG( I ) , ANG, NC, XMOD) 

130 CONTINUE 
XT = XT +10. 

NC = 3 

CALL KTEXTE (XT, YT, HL , HH, I DEG, ANG, NC, XMOD) 

YT = YT + 5 . 

XT = 1 63 . 

NC = 7 

CALL KTEXTE (XT, YT, HL, HH, I THE, ANG, NC, XMOD) 

YT = 220 . 

XT = 60 . 

NC = 3 


NF, XMOD ) 
PLANCHE) 

NF, XMOD ) 


NF , XMOD ) 
NF , XMOD ) 
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CALL KTEXTE(XT, YT, HL, HH, 1ST , ANG, NC, XMOD) 

C***»* ECRITURE DES COTATIONS SUR LES AXES VERTICAUX 
XT=32 . 


NC = 2 
YT =-10. 

DO 140 I = 1 j 6 
YT = YT+20 . 

CALL KF1 XE(XT , YT, HL, HH, I VALX< 1 ) , ANG, NC, XMOD) 
140 CONTINUE 
XT = 21 . 


NC = 3 
CALL 


KTEXTE ( XT , YT , HL, HH, ! XSD , ANG, NC, XMOD) 


c***** 

XT = 32 . 

NC = 2 

DO 150 1=1,6 
YT=YT+20. 

CALL KFIXE1XT, YT, HL, HH, I VALXt I ) , ANG, NC, XMOD) 
150 CONTINUE 
XT = 21 . 


Nc = 3 

CALL KTEXTE(XT,YT,HL,HH, IXSD,ANG,NC,XMOD) 

C*»*** CONVERSION EN SIMPLE PRECISION DE X/D ET THETA 


160 CONTINUE 

DO 170 1=1, NTAB (IF) 

SXSD ( I ) =SNGL ( XOVERD ( I , I F ) ) 
STHETAC I ) =SNGL( THETAS! I , I F) ) 


170 CONTINUE 

NBCT=NBCT+1 

IFCNBCT.EQ. 1 ) YT= 250 . GO TO 180 
C***«* REMPLISSAGE DU TABLEAU 
YT=243 . 

180 CONTINUE 


XT = 25 . 


HL = 2 . 


HH= 2 . 

NC = 7 
ANG=0. 

S=SNGL(FREQ( I F) ) 

CALL KDEC IM(XT,YT,HL,HH,S, ANG , NC , XMOD ) 


XT = 50 . 

S=SNGL(STR< IF) ) 

CALL KDECIMCXT, YT, HL, HH, S, ANG, NC, XMOD) 
XT = XT + 26 , 

S=SNGL ( DFMAX ( IF) ) 

CALL KDECI M( XT, YT, HL, HH, S, ANG, NC, XMOD) 
XT = XT + 26 . 

S=SNGL ( XPEAKN ( IF) ) 

CALL KDEC I M ( XT , YT . HL , HH , S , ANG , NC , XMOD ) 
XT = XT + 26 . 

S=SNGL(XPEAKF( IF) ) 

CALL KDEC I M ( XT , Y T , HL , HH , S , ANG , NC , XMOD ) 
XT = XT + 26 . 

S=SNGL(THETSM( IF) ) 

CALL KDECI M< XT, YT,HL,HH,S, ANG, NC, XMOD) 
XT = XT + 26 . 

S=SNGL ( XDMAX( IF) ) 

CALL KDECI M( XT, YT, HL, HH, S, ANG, NC, XMOD) 


IFCNBCT.EQ. 1 ) YT=220. ; GO TO 190 


C* « *)« * 


YT = 1 00 . 

190 CONTINUE 
XT = 70 , 

NC = 7 

S=SNGL ( STR ( IF) ) 

CALL KDEC 1 M ( XT , YT, HL, HH , S j ANG, NC.XMOD) 

C* ##** 

TRACE EN POINTE DES COURBES 
CXSUJ1 =30. 

CXSU J2= 1 70 . 

CYSUJ 1 = -0 . 5 
CYSUJ2= 1 0 . 

CX0BJ1 =40. 

CX0BJ2=CX-30. 

I F ( NBCT . EQ . 1 ) CYOB J 1 = 1 25 . ; CY0BJ2=230. ; GO TO 200 

CYOBJ 1=5. 

CY0BJ2= 1 10. 

200 CONTINUE 

CALL DEPLACCO. ,XMOD) 

CALL DIMSUJ ( CXSUJ1 , CXSUJ2, CYSUJ 1 , CYSUJ2, XMOD) 

CALL 0 1 MOB J ( CXOB J 1 , CX0BJ2, CY0BJ1 , CY0BJ2.XM0D) 

NBPT = NTAB( IF) 

CALL KSTEP (-16,1,1,1, XMOD ) 

CALL KPO I NT ( STHETA, SXSD, NBPT, XMOD) 

CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD) 

IFCNBCT.NE.2) GO TO 220 
CCX=CX+20. 

CALL DEPLAC(CCX, XMOD) 

GO TO 210 
220 CONTINUE 

CALL DEPLACCO. , XMOD) 

CALL Dl MSUJ ( 0 . , CX, 0. , CY, XMOD) 

CALL D I MOB J ( 0 , , CX , 0 . , CY , XMOD ) 

210 CONTINUE 

I Ft NBCT. EQ. 2) RETURN 
CCX=CX+20 . 

CALL DEPLAC ( CCX , XMOD ) 

RETURN 

END 

I EXEC I NOMB , %KEY = TXSD 

! JOB, T TPEA, P003, P9C0URA, 40, ( REST) MISE EN BIBLOM DE TPEAK 
! COMMENT ETUDE=2895PN 1 4 1 P 

I COMMENT MISE EN BIBLOM DE TPEAK : TRACE DES COURBES THETA-S DU P I C = F ( STROUHAL ) 
ILIMIT (CORE, 50), (TIME, 1 ), (SPDISC, 50), (PAGES, 49) 

I EXEC DLOM, %KEY = TPEAK 
I FORTRAN SI ,LS,GO 

SUBROUTINE TPEAK (KPLANC, THETSM, STR, NFREQ, RNZDIA, VJET, LIB1 , LIB2 
1 , XMOD ) 

C***** SOUS -PROGRAMME DE TRACE DES COURBES THETSM=F(STR) 

REAL*S THETSMf 1 ) , STR( 1 ) 

REAL*8 RNZDIA, VJET 

DIMENSION XMOD ( 1 ) , LIB1 ( 1 ) , LIB2( 1 ) 

c* * * * * 


COMMON / I DENT/NPO I 

COMMON /T I TRE/L I B( 1 0) , I DATE( 3 ) 

C* * * * X 


DIMENSION 

DIMENSION 

DIMENSION 

DIMENSION 


NAM (7) , I POINT (2) 
NASA ( 5 ) 

I VALY ( 6 ) 

I THE C 4 ) j I ST ( 2 ) 


I D I A ( 3 ) 


I V ( 4 ) , I F I G ( 1 ) 
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DIMENSION X ( 2 ) , YC 2) 

DIMENSION VALXC5),XX(5> 
DIMENSION STHETA(33) ,SSTR(33) 




PR0G.N0ISE3 V 


DATA NAM/ ‘ PA- J .BRASSEUR 
DATA CX/300. /, CY/210. / 

DATA I PO I NT / ' PO 1 NT ’ / , I V/ 1 V JET C FT/SEC) = 
DATA I DI A/ 1 DI A . ( FT ) = ’ / , I FI 0/ * F I G . / 

DATA NASA/ 'N.A.S.A./O.N.E.R.A, V 
DATA I VALY/60, 60, 100, 120, 140, 160/ 

DATA l THE/ ' THETA-S DU PIC V 

DATA I ST / ' STROUHAL ' / „ n , 

DATA VALX/+0 .01, +0.10, +1.00, +10.0, +20.0/ 

DATA XX/ 1 6 . , 86 . , 1 56 . , 226 . , 247 . / 

C ***** TRACE DU CADRE ET DU CARTOUCHE 
XT= 1 0 . 

YT = 200 . 

ANQ=0 . 

NC""28 

CALL TPL ( CX, CY, XT, YT , ANG, NAM, NC, XMOD) 

KODE= 1 
NCL=40 

CALL TCART ( KODE , CX , CY, LIB, NCL, I DATE, NC, XMOD) 
KPLANC=KPLANC+ 1 
C**#** ECRITURE NASA 
XT=CX- 1 0 . 

YT = CY -55 . 

HL = 3 . 

HH = 5 . 

ANG=270 . 

NC= 1 9 

CALL KSTEP ( 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTECXT, YT, HL, HH, NASA, ANG, NC, XMOD) 
CALL KSTEP ( 1 , 1 , 1 , 1 j XMOD) 

C* * * # * ECRITURE DANS LA MARGE DE L1B1 ET LIB2 

HL = 2 . 5 
HH=2 . 5 
NC = 80 


ANG = 0 . 

XT = 1 00. 

YT=CY -6 . 5 

CALL KTEXTECXT, YT, HL, HH, LIB1 , ANG, NC, XMOD) 
YT=CY -16.5 

CALL KTEXTE < XT , YT , HL , HH , L I B2 , ANG , NC, XMOD ) 
C***** ECRITURE DE POINT 
XT =10. 

YT = CY - 30 . 


NC = 5 
HL = 3 . 
HH=3. 


ANG=0, 

CALL KTEXTEfXT, YT, HL, HH, 


I PO I NT , ANG , NC , XMOD ) 


C*#*** 

XT = XT +18. 

CALL KFI XE(XT,YT,HL,HH,NPOI, ANG, NC, XMOD) 

C***** ECRITURE DE VJET 
XT=50. 

NC= 1 3 
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CALL KTEXTE ( XT , YT , HL, HH, IV, ANG, NC, XMOD) 

C* * * * * 


XT = XT +42 . 

NC = 6 

S=SNGL ( V JET ) 

CALL KDECIM<XT, YT, HL , HH, S, ANG, NC, XMOD ) 

C* * * * * ECRITURE DE DtA.(FT) = 

XT= 1 20. 

NC = 9 

CALL KTEXTE ( XT , YT, HL, HH, IDI A, ANG, NC, XMOD) 

C* # * # * 


S = SNGL ( RNZD I A ) 
XT =XT+30 . 

NC = 5 


CALL KDEC I M ( XT, YT, HL, HH, S, ANG, NC, XMOD) 

C* * * * # ECRITURE DE FIG. 

XT=200 . 

NC = 4 

CALL KTEXTE ( XT, YT, HL , HH , I FI G, ANG, NC, XMOD) 
C***** TRACE DE L AXE VERTICAL 
XT = 20 . 

YT=20 . 

ANG = 90 . 

XM I N= 1 . 

NC = 0 


PAS= 1 . 
NGRAD= 1 2 
NF = 0 


0 * * # * * 


PASMM= 1 0 . 

CALL KAXE( XT , YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
ECRITURE DES COTATIONS SUR L AXE VERTICAL 
XT =10, 


HL=2. 
HH = 2 . 
YT = 0 . 


ANG=0 , 
NC = 3 


DO 100 1=1,6 
YT = YT + 20 . 

CALL KFI XE(XT, YT, HL, HH, I VALY Cl), ANG, NC, XMOD) 
100 CONTINUE 

C# * # * * ECRITURE DE THETA-S DU PIC 
Y T = YT +13. 

XT =10. 

NC= 1 4 


CALL KTEXTE ( XT, YT, HL , HH , I THE , ANG, NC, XMOD ) 
C* # * * * TRACE DE L AXE HORIZONTAL 
X( 1 ) =20 . 

X ( 2 ) =251 . 

Y ( 1 ) =20 . 

Y ( 2 ) = Y ( 1 ) 

CALL KTRACECX, Y, 2, XMOD) 

C* * * # * ECRITURE DE STROUHAL 
XT = 255 . 

YT = 20 . 

HL = 2 . 

HH = 2 . 


ANG=0 . 
NC = 8 


CALL KTEXTECXT, YT, HL, HH, I ST , ANG , NC , XMOD ) 
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C***x* ECRITURE DES C0TAT10NS SUR L AXE HORIZONTAL 
YT =14. 

NC = 5 

DO 110 1=1,5 

CALL KDEC I M ( XX ( I ) , YT, HL, HH, VALX( I ) , ANG, NC, XMOD) 
110 CONTINUE 

GRADUATIONS DE L AXE HORIZONTAL 
CX0BJ1 =20. 

CX0BJ2=251 . 

CYOB J 1=17.5 
CYOB J2=22 . 5 
CXSUJ1 =Al.0G1 0(0.01 ) 

CXSUJ2=ALCG1 0( 20 . ) 

CYSUJ 1 = -2 . 5 
CYSUJ2= + 2 . 5 
CALL DEPLAC ( 0 . , XMOD ) 

CALL D I MSU J ( CXSU J 1 , CXSUJ2, CYSUJ 1 , CYSUJ2, XMOD) 
CALL DIMOBJ ( CXOBJ 1 , CX0BJ2, CY0BJ1 , CY0BJ2, XMOD) 


Y ( 1 ) = -2 . 5 
Y ( 2 ) = +2 . 5 
PASX=0. 001 
DO 120 J=1 ,3 
PASX=PASX* 10. 

DO 120 1=1,9 

XC 1 )=AL0G10( I *PASX ) 

X I 2 ) =X ( 1 ) 

CALL KTRACE (X, Y, 2, XMOD) 

120 CONTINUE 

X( 1 )=AL0G10< 10. ) 

X ( 2 ) =X ( 1 ) 

CALL KTRACE ( X , Y , 2, XMOD ) 

X ( 1 ) =AL0G1 0 ( 20 . ) 

X ( 2 ) =X ( 1 ) 

CALL KTRACE ( X, Y , 2, XMOD ) 

C***x* TRACE DES COURSES EN POINTE 
CXOBJ 1 =20. 

CX0BJ2=251 . 

CY0BJ1 =20. 

CYOB J2= 1 30 . 

CXSUJ 1 = AL0G1 0 ( +0 . 01 ) 

CXSUJ2 = ALQG1 0( +20 . ) 

CYSUJ 1 =G0 . 

CYSUJ2=1 70. 

CALL DEPLAC ( 0. , XMOD) 

CALL D I MSU J ( CXSUJ 1 , CXSU J2 , CYSUJ 1 , CYSUJ2, XMOD) 

CALL DI MOBJ ( CXOBJ 1 , CX0BJ2, CY0BJ1 , CY0BJ2, XMOD) 
C«x*x* CONVERSION EN SIMPLE PRECISION DE THETSM ET STR 
NBPT=0 

DO 130 1=1, NFREQ 

IFCSTRC I ) . LT. CO. 01 ) . OR. STR( I ) .GT. (+20. ) ) GO TO 130 
NBPT = NBPT + 1 

STHETA ( NBPT ) =SNGL ( THETSM ( I ) ) 

SSTRI NBPT) =SNGL(STR( I ) ) 

SSTR ( NBPT ) = ALOG 1 0 ( SSTR ( NBPT ) ) 

130 CONTINUE 
C****x 

CALL KSTEPC -16, 1 , 1 , 1 ,XMOD) 

CALL KPQ I NT ( SSTR , STHETA , NBPT , XMOD ) 

CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD ) 


c* # # # * 


CCX=CX+20. 

CALL DEPLAC ( CCX , XMOD ) 

RETURN 

END 

I EXEC I NOMB , %KEY = TPEAK 

! JOB, T DECB, P003, P9C0URA, 40, (REST) MISE EN BIBLOM DE SAVDECB 
! COMMENT ETUDE=2895PN1 4 1 P 

I COMMENT MISE EN BIBLOM DU SOUS -PROGRAMME SAVDECB 
I LI MI T (CORE, 50) , (TIME, 1 ) , (SPDISC, 50 , ( PAGES, 49) 

I EXEC DLOM, %KEY = SAVDECB 
I FORTRAN S I , LS, LO, GO 

SUBROUTINE SAVDECB ( DECB ) 

REAL*8 DECB( 1 30, 35) , DECBS 
COMMON /DONTD/DECBS( 130, 35) 

DO 100 J=1 , 130 
DO 100 1=1,35 
DECBS ( J, l ) =DECB( J, I ) 

100 CONTINUE 
RETURN 
END 

I EXEC t NOMB, JCKEY = SAVDECB 

! JOB, T XSDN, P003, P9C0URA, 40, (REST) MISE EN BIBLOM DE TXSDN 
ICOMMENT ETUDE=2895PN1 4 1 P 

ICOMMENT MISE EN BIBLOM DE TXSDN: TRACE DES COURSES X/D=F( THETA-S ) 
ICOMMENT AUX ECHELLES NASA 

I LI MIT (CORE, 50) , (TIME, 1 ), (SPDISC, 50) , (PAGES, 49) 

I EXEC DLOM, %KEY= TXSDN 
I FORTRAN S I , LS , GO 

SUBROUTINE TXSDN ( KPLANC, XOVERD, THETAS, NTAB, NFREQ, XDMAX , 

1 THETSM, RNZOI A, VJET, FREQ, LI B1 , LI B2, XMOD) 

C***** SOUS -PROGRAMME DE TRACE DES COURBES X/D=F( THETAS) 

REAL* 8 XOVERD (50, 33) , THETAS (50, 33 ) , XDMAX ( 33 ) , THETSM (33) 

REAL*8 RNZDI A, VJET, FREQ( 33) 

COMMON / I DENT/NPOI 

COMMON /T! TRE/L I B( 1 0) , I DATE( 3) 

COMMON /TABD/STR( 33) , DFMAX(33) , XPEAKN ( 33 ) , XPEAKF ( 33 ) 

REAL*8 STR,DFMAX, XPEAKN, XPEAKF 
DIMENSION XMOD ( 1 ) , NTAB( 1 ) , L 1 B1 ( 1 ) , L I B2( 1 ) 

c* * * * * 

DIMENSION NAM ( 7 ) , NASA ( 5 ) , IP0INT(2), I DEG( 1 ) 

DIMENSION I V ( 4 ) , ID!A(3), I ST ( 1 ) , IDIF(2), I PEAK (3) , I NEAR ( 1 ) , I FAR( 1 ) 
DIMENSION I THE (2), IXSDtl ), I FREQ (1 ) 

D I MENS I ON I ANG ( 7 ) , X I ANG ( 7 ) , I VALX ( 6 ) 

DIMENSION SXSD (50) ,STHETA( 50 ) 

DIMENSION IFIG(1) 

DIMENSION X12(2) ,Y12(2) 

c* * * * * 

DATA NAM/ 1 PA- J . BRASSEUR ECH . N . A . S . A . ' / 

DATA NASA/ ' N. A. S. A. /O . N. E. R. A. '/ 

DATA I POINT/ ‘POINT •/ 

DATA I DEG/ ' DEG ‘ / 

DATA IV/ 'VJET(FT/SEC)= */ 

DATA IDIA/'DIA, (FT)= ‘/,IST/‘ST= ' /, I Dl F/ ‘ Dl F . MAX * / 

DATA I PEAK/ 'PEAK (DEG. ) ' / , I NEAR/ ‘ NEAR ' / , I FAR/ ‘ FAR '/ 

DATA I THE/ ’ THETA-S '/,IXSD/'X/D ‘ / , I FREQ/ ‘ FREQ ‘ / 

C***»* 

DATA CX/210. /, CY/300. / 

DATA I ANG/40, 60, 80, 100, 120, 140, 160/ 

DATA XI ANG/47. 25 , 67 . 75 , 88 . 25, 1 08 . 75, 1 29 . 25, 1 49 . 75, 170.25/ 
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DATA IVALX/0,2,4,6,8, 10/ 

DATA IFIG/'FIQ. '/ 

Q# 5K )K K $ 

TRACE DE 2 COURBES PAR PLANCHE 
NBCT=0 

DO 210 I F= 1 , NFREQ 
I F ( NTABC IF) . EQ . 0) GO TO 210 
I F ( NBCT . EQ . 1 ) GO TO 1 60 
C****# TRACE DU CADRE ET DU CARTOUCHE 
IFCNBCT. EQ. 2) NBCT=0 
XT =10. 

YT= 1 0 . 

ANG=90 . 

NC = 28 

CALL TPL ( CX , CY , XT , YT , ANG , NAM , NC , XMOD ) 

K0DE=0 
NCL=40 
NC= 1 

CALL TCART(KODE, CX, CY, LIB, NCL, I DATE, NC, XMOD) 
KPLANC=KPLANC+ 1 
Q#*### ECRITURE NASA 
XT=55. 

Y T = CY - 1 0 . 

HL = 3. 

HH=5. 

AN0=O. 

NC= 1 9 

CALL KSTEP ( 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTE(XT, YT, HL, HH, NASA, ANG, NC.XMOD) 
CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD) 

C***** ECRITURE DANS LA MARGE DE L!B1,LIB2 
HL=2 . 5 
HH=2. 5 
NC = 80 
ANG=90 . 

XT=6 . 5 
YT= 1 00. 

CALL KTEXTE1XT, YT, HL, HH, LIB1 , ANG, NC, XMOO) 

XT =16.5 

CALL KTEXTE(XT, YT, HL, HH, LIB2, ANG, NC, XMOD) 
C#**#* ECRITURE NPOI 
XT = 25 . 

YT = CY - 28 . 

NC = 5 
HL = 3 . 

ANG= 0 . 

HH=3 , 

CALL KTEXTE(XT, YT, HL, HH, I P01 NT, ANG, NC, XMOD) 

XT = XT +18. 

NC = 4 

CALL KFIXEtXT, YT,HL,HH, NPOI , ANG, NC.XMOD) 
ECRITURE V JET 
XT = XT +18. 

NC= 1 3 

CALL KTEXTECXT, YT, HL, HH, I V, ANG, NC, XMOD) 

S=SNGL ( VJET ) 

XT = XT +42 . 

NC = 6 


CALL KDEC ! M ( XT, YT, HL, HH ( S, ANG, NC, XMOD) 

C* * # * * ECRITURE DE DIA.(FT) 

XT = XT + 24 , 

NC = 9 

CALL KTEXTE ( XT, YT, HL, HH, IDI A, ANG, NC,XMOD) 

C****« 

XT = XT + 30 . 

NC = 5 

S = SNGL ( RNZD I A ) 

CALL KDEC I M ( XT, YT, HL, HH, S, ANG, NC, XMOO) 

C ***** ECRITURE DE FIG. 

XT=XT + 30 . 

NC = 4 

CALL KTEXTE ( XT, YT, HL, HH, IFIG, ANG, NC,XMOD> 
C***** TRACE DU TABLEAU 
X 1 2 ( 1 ) =20 . 

X12(2)=CX-10. 

Y 1 2 ( 1 )=CY-45. 

Y 1 2( 2 ) =Y 1 2 ( 1 ) 

CALL KTRACECX12, Y12, 2, XMOD) 

X 1 2 ( 1 )=18. 

Y 1 2 ( 1 )=CY-60. 

Y 1 2( 2 ) =CY -35 . 

DO 110 1=1,7 
XI 2 ( 1 ) =X 1 2 ( 1 ) +26 . 

XI 2 ( 2 ) =X 1 2 ( 1 ) 

I F ( I . EQ . 4 ) GO TO 100 
CALL KTRACE ( X 1 2, Y 1 2, 2, XMOD ) 

GO TO 110 
100 CONTINUE 

Y12C2)=Y12(2)-5. 

CALL KTRACE (X12,Y12,2, XMOD ) 

Y 1 2 ( 2 ) = CY - 35 . 

1 10 CONTINUE 

C***** DIFFERENTES INSCRIPTIONS DU TABLEAU 
YT=CY -40 . 

XT=26 . 

ANG=0 . 

HL = 3 . 

HH = 3 . 

NC = 4 

CALL KTEXTE ( XT, YT, HL, HH, I FREQ, ANG, NC, XMOD) 

C** * * * 

XT = 54 . 

NC = 2 

CALL KTEXTE ( XT, YT , HL, HH, 1ST, ANG, NC,XMOD) 

C* #* # # 

XT = 72 . 

NC = 8 

CALL KTEXTE ( XT , YT, HL, HH, I D I F , ANG , NC , XMOD ) 

C* * * * * 

YT = YT + 2 . 

XT = 1 07 . 

NC= 1 0 

CALL KTEXTE ( XT, YT, HL, HH, I PEAK , ANG , NC, XMOD ) 
YT=YT-5 . 

XT = 1 03 . 

NC = 4 

CALL KTEXTE(XT, YT, HL, HH, I NEAR, ANG , NC , XMOD ) 
XT = 1 30 . 



NC = 3 

CALL KTEXTECXT, YT, HL , HH, I FAR, ANG, NC, XMOD) 

Q# * * * * 

YT = CY -40 , 

XT = 1 50 . 

NC = 7 

CALL KTEXTE(XT,YT,HL,HH, I THE , ANG , NC , XMOD ) 

0 * ** *x 

XT=CX-26. 

NC = 3 

CALL KTEXTECXT, YT, HL, HH, I XSD , ANG , NC , XMOD ) 

0* * # * * TRACE DU PREMIER AXE VERT I CAL ( PART I E HAUTE DE LA 
XT = 40 , 

YT= 1 30 , 

NC = 0 

PASMM = 20 . 5 
ANG=90 . 

XMI N=1 . 

PAS= 1 . 

NGRAD=6 
NF = 0 

CALL KAXE ( XT , YT , NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD , 
0***** TRACE DU SECOND AXE VERT I CAL ( PART I E BASSE DE LA 
YT =10. 

CALL KAXE ( XT, YT, NORD, NC, PASMM, ANG, XM! N, PAS, NGRAD, 
0###** TRACE DU PREMIER AXE HORIZONTAL 
XT = 40 . 

YT= 1 30 . 

ANG=0 , 

PASMM = 1 0 . 25 
NGRAD= 1 5 

CALL KAXE ( XT , Y T , NORD , NC , PASMM , ANG , XM I N , PAS , NGRAD , 
0#**## TRACE DU SECOND AXE HORIZONTAL 
YT =10. 

CALL KAXECXT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, 
0##*#* ECRITURE DES COTATIONS SUR LES AXES HORIZONTAUX 
YT = 5 . 

ANG=0 , 

HL = 2 . 

HH = 2 . 

NC = 3 

DO 120 1=1,7 
XT=X I ANG ( I ) 

CALL KF I XE( XT, YT, HL, HH, I ANG ( I ) , ANG, NC, XMOD) 

120 CONTINUE 

XT = XT +10. 25 
NC = 3 

CALL KTEXTECXT, YT, HL, HH, I DEG, ANG , NC, XMOD ) 

YT =10. 

XT=1 66. 5 
NC = 7 

CALL KTEXTE ( XT, YT , HL, HH, I THE, ANG, NC,XMOD) 

Y T= 1 00 . 

XT = 60 . 

NC = 3 

CALL KTEXTECXT, YT, HL, HH, I ST, ANG, NC, XMOD) 

0* * * # X 

YT = 1 25 . 

NC = 3 

DO 130 1=1,7 


PLANCHE) 

NF , XMOD ) 
PLANCHE) 

NF, XMOD) 

NF , XMOD ) 
NF , XMOD ) 
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XT = X I ANG C I ) 

CALL KFIXECXT, YT, HL, HH, I AMG ( I ) , ANG, NC, XMOD) 

130 CONTINUE 

XT = XT +10. 25 
NC = 3 

CALL KTEXTE ( XT, YT , HL, HH, I DEG, ANG, NC,XMOD) 

YT = YT +5 . 

XT = 1 86 . 5 
NC = 7 

CALL KTEXTE ( XT, YT, HL, HH, I THE, ANG, NC, XMOD) 

YT = 220 , 

XT = 60 . 

NC = 3 

CALL KTEXTE ( XT, YT, HL, HH, I ST , ANG , NC , XMOD ) 

C***#* ECRITURE DES COTATIONS SUR LES AXES VERTICAUX 
XT = 32 . 

NC = 2 

YT= - 1 0 . 5 
DO 140 1=1,6 
YT = YT + 20 . 5 

CALL KFIXE(XT, YT, HL, HH, I VALXC I ) , ANG, NC, XMOD) 

140 CONTINUE 
XT = 21 . 

NC = 3 

CALL KTEXTE ( XT, YT, HL, HH, I XSD, ANG, NC , XMOD ) 

C* * * # * 

XT = 32 . 

YT= 1 09 . 5 
NC = 2 

DO 150 1=1,6 
YT = YT + 20 . 5 

CALL KFIXE(XT,YT,HL,HH, IVALXCI ), ANG, NC, XMOD) 

150 CONTINUE 
XT = 21 . 

NC = 3 

CALL KTEXTE (XT, YT, HL, HH, I XSD, ANG, NC, XMOD ) 

C* * * * * CONVERSION EN SIMPLE PRECISION DE X/D ET THETA 
160 CONTINUE 

DO 170 1=1, NTAB (IF) 

SXSD ( I ) =SNGL ( XOVERD ( I , I F ) ) 

STHETA ( I ) =SNGL ( THETAS ( I , I F) ) 

170 CONTINUE 

NBCT = NBCT + 1 

I F ( NBCT . EQ . 1 ) YT=250 . ; GO TO 180 

C* * * * * REMPLISSAGE DU TABLEAU 
YT=243 . 

180 CONTINUE 
XT = 25 . 

HL = 2 . 

HH = 2 . 

NC = 7 
ANG=0 . 

S=SNGL(FREQ( IF)) 

CALL KDEC IM(XT,YT,HL,HH,S, ANG , NC , XMOD ) 

XT=50 . 

S=SNGL ( STR ( IF) ) 

CALL KDEC I M( XT, YT, HL, HH,S, ANG, NC, XMOD) 

XT = XT + 26 . 

S=SNGL(DFMAX( IF) ) 

CALL KDEC I M ( XT, YT, HL,HH,S, ANG, NC,XMOD) 



XT = XT + 26 . 

S=SNGL ( XPEAKN ( IF) ) 

CALL KDECIMCXT, YT, HL, HH, S, ANG , MC , XMOD ) 
XT = XT + 26 . 

S=SNGL ( XPEAKF ( IF) ) 

CALL KDECI MCXT, YT, HL, HH, S, ANG, NC, XMOD) 
XT = XT + 26 . 

S=SNGL( THETSMC IF) ) 

CALL KDEC I M( XT, YT, HL, HH, S, ANG, NC, XMOD) 
XT =XT+26 . 

S = SNGL. ( XDMAX ( IF) ) 

CALL KDECIMCXT, YT, HL, HH, S, ANG, NC, XMOD) 


I F ( NBCT . EQ . 1 ) YT=220 . ; GO TO 190 

YT= 1 00 . 

190 CONTINUE 
XT = 70 . 

NC = 7 

S=SNGL ( STR ( IF) ) 

CALL KDEC I MCXT, YT, HL, HH, S, ANG, NC, XMOD) 


Q $ ft ft ft ft 

c***** TRACE EN POINTE DES COURBES 
CXSUJ1 =30. 

CXSUJ2= 1 70 . 

CYSUJ 1 = -0 . 5 
CYSUJ2= 10. 

CX0BJ1 =40. 

CXOB J2= 1 ©3 . 5 „„ 

IFCNBCT. EQ. 1 ) CYOBJ 1 = 1 24 . 875 ; CY0BJ2=232.5 ; GO TO 200 

CY0BJ1 =4 . 875 
CY0BJ2= 1 12.5 
200 CONTINUE 

CALL DEPLACCO. ,XMOD) 

CALL D I I1SUJ ( CXSUJ 1 , CXSUJ2, CYSUJ 1 , CYSUJ2, XMOD) 

CALL D I MOBJ ( CXOBJ 1 , CX0BJ2, CYOBJ 1 , CY0BJ2, XMOD ) 

NBPT = NTAB( IF) 

CALL KSTEP C - 1 6 , 1 , 1 , 1 , XMOD ) 

CALL KPOI NT (STHETA, SXSD, NBPT, XMOD) 

CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD ) 

IFCNBCT. NE. 2) GO TO 220 
CCX=CX+20. 

CALL DEPLACCCCX, XMOD) 

GO TO 210 
220 CONTINUE 

CALL DEPLAC ( 0 . , XMOD ) 

CALL DIMSUJCO. , CX, 0. , CY, XMOD) 

CALL D I MOBJ CO., CX, 0 . , CY , XMOD ) 

210 CONTINUE 

I FC NBCT. EQ. 2) RETURN 


CCX=CX+20 . 

CALL DEPLACCCCX, XMOD) 

RETURN 
END 

I EXEC INOMB, %KEY = TXSDN 
! JOB, T PEAN, P003, P9C0URA, 40, (REST) 

ICOMMENT ETUDE = 2895PN 1 4 1 P 
ICOMMENT MISE EN BIBLOM DE TPEAKN : TRACE DES COURBES THETA-S DU PI 
ICOMMENT AUX ECHELLES NASA 

I LI MI T ( CORE, 50) , ( T I ME, 1 ) , (SPDI SC, 50) , (PAGES, 49) 

I EXEC DLOM, %KEY = TPEAKN 


MISE EN BIBLOM DE TPEAKN 


C=F (STROUHAL) 
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I FORTRAN SI , LS, GO 

SUBROUTINE TPEAKN ( KPLANC , THETSM, STR, NFREQ, RNZD I A , VJET, L I B 1 , L I B2 
1 , XMOD ) 

C***** SOUS -PROGRAMME DE TRACE DES COURBES THETSM=F( STR ) 

C***** AUX ECHELLES NASA 

REAL*© THETSM (1 ) , STR ( 1 ) 

REAL*8 RNZD I A, VJET 

DIMENSION XMOD ( 1 ) , L I B 1 ( 1 ) , L I B2 ( 1 ) 

C***** 

COMMON / I DENT/NPO I 

COMMON /T I TRE/L I B( 1 0) , I DATE C 3 ) 

C* * * * * 

DIMENSION NAM ( 7 ) , IPOINT(2) J IDIA(3) J IV(4),IFI0C1) 

DIMENSION NASA ( 5 ) 

DIMENSION I VALY ( 6 ) 

DIMENSION I THE C4 ) , I ST ( 2 ) 

DIMENSION X( 2) , Y( 2) 

DIMENSION VALX(5) , XX (5) 

DIMENSION STHETA ( 33 ) , SSTRC 33) 

DATA NAM/ ' PA-J . BRASSEUR ECH . N . A . S . A. V 
DATA CX/300 . / , CY/2 1 0 . / 

DATA I PO I NT / ' PO I NT V, I V/ ' VJET ( FT/SEC ) = V 

DATA I D I A/ * D I A . C FT ) = V , I F I 0/ ' F I G . 1 / 

DATA NASA /'N.A.S.A./O.N.E.R.A. V 
DATA I VALY/60, 80,100,120,140, 160/ 

DATA I THE/ 'THETA-S DU PIC V 
DATA I ST/ 'STROUHAL V 

DATA VALX/+0 . 01 , +0. 1 0, +1 .00 ,+10.0,+ 20.0/ 

DATA XX/ 1 6 .,81. 5, 147. ,212. 5, 232 . 5/ 

C* * * * * TRACE DU CADRE ET DU CARTOUCHE 
XT =10. 

YT = 200 . 

ANG=0 . 

NC = 28 

CALL TPL ( CX, CY , XT, YT, ANG, NAM, NC, XMOD) 

KODE= 1 
NCL=40 
NC= 1 

CALL TCART ( KODE , CX, CY , LIB, NCL , I DATE, NC, XMOD) 

KPLANC = KPLANC + 1 
C***** ECRITURE NASA 
XT = CX- 1 0 . 

YT = CY - 55 . 

HL= 3 . 

HH = 5 . 

ANG=270 . 

NC= 1 9 

CALL KSTEP ( 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTE ( XT , YT , HL , HH, NASA, ANG, NC,XMOD) 

CALL KSTEP ( 1,1,1, 1 , XMOD ) 

C***#* ECRITURE DANS LA MARGE DE LIB1 ET L I B2 
HL = 2 . 5 
HH = 2 . 5 
NC = 80 
ANG=0 . 

XT = 1 00 . 

YT = CY -6.5 

CALL KTEXTE (XT, YT, HL , HH, L I B1 , ANG , NC, XMOD ) 

YT = CY -16.5 



CALL KTEXTE(XT, YT, HL, HH, LIB2, ANG, NC, XMOD) 

Cxxxxx ECRITURE DE POINT 
XT =10. 

YT=CY -30 . 

NC = 5 
HL = 3 . 

HH=3 . 

AN0 = 0 . 

CALL KTEXTE(XT, YT, HL, HH, I POI NT, ANG, NC, XMOD) 

C*»*** 

XT = XT +18. 

NC = 4 

CALL KF I XE C XT , YT , HL , HH , NPO t , ANG, NC , XMOD ) 

Cxxxxx ECRITURE DE VJET 
XT=50 . 

NC= 1 3 

CALL KTEXTE ( XT , YT , HL , HH , I V , AND , NC , XMOD ) 

XT = XT +42 . 

NC = 6 

S=SNGL(VJET) 

CALL KDEC I M ( XT , YT , HL , HH , S , ANG , NC , XMOD ) 

C***** ECRITURE DE DIA.CFT)= 

XT= 1 20 . 

NC=9 

CALL KTEXTE (XT, YT, HL, HH, I D I A, ANG, NC, XMOD) 

c# x * * x 

S=SN0L ( RN2D I A ) 

XT = XT + 30 . 

NC = 5 

CALL KDEC I M( XT, YT,HL, HH , S , ANG , NC , XMOD ) 

C* * x * * ECRITURE DE FIG. 

XT = 200 . 

NC = 4 

CALL KTEXTE ( XT , YT , HL , HH , I FI G, ANG, NC, XMOD) 

Cxxxxx TRACE DE L AXE VERTICAL 
XT = 20 . 

YT=20. 

ANG=90 . 

XMI N= 1 . 

NC = 0 
PAS= 1 . 

NGRAD= 1 2 
NF = 0 

CALL KAXE ( XT, YT, NORD, NC, PASMM, ANG, XMIN, PAS, NGRAD, NF, XMOD) 
Cxxxxx ECRITURE DES COTATIONS SUR L AXE VERTICAL 
XT =10. 

HL = 2 . 

HH = 2 . 

YT = - 6 . 

ANG=0 . 

NC = 3 

DO TOO 1=1,6 
YT = YT +26 . 

CALL KFI XE(XT, YT, HL, HH, I VALY ( I ), ANG, NC, XMOD ) 

100 CONTINUE 

Cxxxxx ECRITURE DE THETA-S DU PIC 
YT = YT +16. 

XT =10. 
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NC= 1 4 

CALL KTEXTEIXT , YT, HL, HH, I THE, ANG, NC, XMOD) 

TRACE DE L AXE HORIZONTAL 
X< 1 ) =20 . 

X ( 2) =236.5 
Y ( 1 ) =20 . 

Y ( 2 ) =Y ( 1 ) 

CALL KTRACEIX, Y, 2, XMOD) 

ECRITURE OE STROUHAL 
XT=240. 5 
YT=20. 

HL = 2. 

HH=2 . 

ANG=0 . 

NC=6 

CALL KTEXTEtXT , YT , HL. , HH, I ST, ANG, NC, XMOD) 
ECRITURE DES COTATIONS SUR L AXE HORIZONTAL 
YT= 1 4 . 

NC = 5 

DO 110 1=1,5 

CALL KDEC I M ( XX ( I ) , YT, HL, HH, VALX( I ) , ANG, NC.XMOD) 
110 CONTINUE 

GRADUATIONS DE L AXE HORIZONTAL 
CX0BJ1 =20. 

CX0BJ2=236. 5 
CYOBJ 1=17.5 
CY0BJ2=22 . 5 
CXSUJ1 =AL0G1 0(0. 01 ) 

CXSUJ2=AL0G1 0( 20 . ) 

CYSUJ1 =-2. 5 
CYSUJ2= +2 . 5 
CALL DEPLACCO. .XMOD) 

CALL D I MSU J ( CX3UJ 1 , CXSUJ2, CYSUJ 1 , CYSUJ2, XMOD) 
CALL D I MOB J ( CXOB J 1 , CX0BJ2, CYOBJ 1 , CY0BJ2, XMOD) 

C* * * * * 

Y ( 1 ) = -2 . 5 
Y ( 2 ) = +2 . 5 
PASX = 0 . 001 
DO 120 J= 1 , 3 
PASX=PASX* 1 0 . 

DO 120 1=1,9 
X ( 1 ) =AL0G1 0( I *PASX ) 

X ( 2 ) =X ( 1 ) 

CALL KTRACECX, Y, 2, XMOD) 

120 CONTINUE 

X( 1 )=AL0G10( 10. ) 

X(2)=X( 1 ) 

CALL KTRACECX, Y, 2, XMOD) 

X( 1 ) =AL0G1 0( 20 . ) 

X ( 2 ) =X ( 1 ) 

CALL K TRACE ( X, Y , 2, XMOD ) 

TRACE DES COURBES EN POINTE 
CX0BJ1 =20. 

CX0BJ2=236 . 5 
CY0BJ1 =20. 

CY0BJ2= 1 63 . 

CXSUJ1 =AL0G1 01+0.01 ) 

CXSUJ2 = AL0G10( +20. ) 

CYSUJ1 =60. 

CYSUJ2= 1 70 . 
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CALL DEPLAC ( 0 . , XMOD ) 

CALL DI MSUJ ( CXSUJ1 , CXSUJ2, CYSUJ1 , CYSUJ2, XMOD) 
CALL DI MOBJ ( CXOBJ 1 , CXOBJ2, CYOBJ1 , CY0BJ2, XMOD) 
C***** CONVERSION EN SIMPLE PRECISION DE THETSM ET STR 


NBPT=0 

DO 130 1 = 1, NFREQ „ , _ _ 

I F(STR( I ) . LT . ( 0 . 01 ) . OR. STR( I ) . GT . ( +20. ) ) GO TO 130 

NBPT=NBPT+1 

STHETA(NBPT) =SNGL ( THETSM ( 1 ) ) 

SSTR(NBPT) =SNGL(STR( I ) 1 
SSTR ( NBPT ) =ALO01 0 ( SSTR ( NBPT ) ) 

130 CONTINUE 


CALL KSTEP (-16,1,1,1, XMOD ) 

CALL KPO I NT ( SSTR , STHETA , NBPT , XMOD ) 
CALL KSTEP( 1 , 1 , 1 , 1 , XMOD ) 


c* * * * * 

rrv *= py + pn 

CALL DEPLAC ( CCX j XMOD ) 

RETURN 

END 

I EXEC I NOMB , %KEY = TPEAKN 


ooo o o ooo 


■PROGRAMMME SOURCE P242 

C TRANSFERT DE LA BANDE NUMERIQUE SUR LE DISQUE 

DIMENSION MAT (50) 

NR= 1 
ND = 2 

10 CALL BUFFER IN (NR, 1 , MAT, 50, I BU) 

CALL BUFFER CHECK ( NR, 1 , I BU, MOT ) 

IF (IBU.EQ.3) GO TO 500 
C ECRITURE SUR DISQUE 

WRITE(ND, 101 ) ( MAT ( I ), 1=1,50) 

101 FORMAT (50A4) 

GO TO 10 

500 STOP 
END 

■PROGRAMME SOURCE P244 

LECTURE DE BANDE BLOCS EN BCD FORMATTES FORMAT VARIABLE 
TRAI TEMENT DE PLUSIEURS FICHIERS 
ECRITURE SUR DISQUE BLOCS EN EBCDIC FORMAT FIXE 
DIMENSION NZTYPE ( 3 ) , FREQ (30) , ANGLES ( 50 ) , RDIST(50) , DECB(50, 31 ) 
DIMENSION MAT (100), NOMF I CH( 5) 

NR= 1 
ND = 2 
NF I CH = 0 

SAUT DE FICHIERS 
READ( 105, 1 02) NFS 

102 FORMAT ( 15) 

I F ( NFS . EQ . 0 )G0 TO 20 

10 CALL BUFFER IN ( NR, 1 , MAT, 01 , 1 BU ) 

CALL BUFFER CHECK ( NR, 1 , I BU, MOT ) 

IF (IBU.EQ.3) NF I CH=NF I CH+ 1 
I F ( NF I CH . EQ . NFS ) GO TO 20 
GO TO 10 
20 NF I CH=0 

300 READ( 105, 103, END=600) ( NOMF I CH ( I ) , I =1 , 5) 

NF I CH=NF I CH+ 1 

103 FORMAT ( 5A4 ) 

ASSIGNATION DYNAMIQUE DU FI CHI ER DISQUE 
CALL AWSM ( ' D I SK ’ , ND , NOMF I CH , ‘F 1 , 1024, 124) 

LECTURE D UN FI CHI ER 

30 CALL BUFFER IN ( NR, 1 , MAT, 34 , I BU ) 

CALL BUFFER CHECK ( NR, 1 , I BU, MOT ) 

I F( IBU. EQ. 3 )G0 TO 30 

DECODE! 1 28, 250, MATO) ) I PT, N, VTUN, VJET, TEMPR, RHUM.SI DE, PRESS, XMACH, 
■D1ANZL, NZTYPE 

WRI TE(ND, 1 50) I PT, N, VTUN, VJET, TEMPR, RHUM, SIDE, PRESS, XMACH, DI ANZL, NZ 
■ TYPE 
C 

CALL BUFFER IN ( NR, 1 , MAT, 92, I BU ) 

CALL BUFFER CHECK ( NR, 1 , I BU, MOT) 

DECODE (360, 252, MAT( 3) ) ( FREQ( I ) , I =1 , 30) 

WR I TE ( ND, 152) (FREQ (I ), 1=1,30) 

C 

CALL BUFFER IN ( NR, 1 , MAT, 68 , I BU ) 

CALL BUFFER CHECK ( NR , 1 , I BU, MOT ) 

DECODE ( 264 , 254 , MAT ( 3 ) ) ( ANGLES ( I ) , I = 1 , N) 

WRI TE( NO, 1 54 ) ( ANGLES! I ) , I = 1 , N) 

C 

CALL BUFFER IN ( NR, 1 , MAT, 68, I BU ) 

CALL BUFFER CHECK ( NR , 1 , I BU, MOT ) 



DECODE C 264 , 254 , MAT ( 3 ) ) ( RD I ST ( I ), 1=1, N) 
WRI TECND, 154) (RDISTt I ) , l =1 , N) 

DO 180 J=1 ,N 

CALL BUFFER IN ( NR, 1 , MAT , 95 , I BU ) 

CALL BUFFER CHECK CNR, 1 , 1BU,M0T) 

DECODEC 372, 254.MATC3) ) CDECBC J, I ) , I = 1 , 31 ) 
180 WRI TEC ND, 1 54) CDECBC J, I ) , I =1 , 31 ) 

REWIND ND 

WRI TEC 1 08, 1 04 ) NF I CH 
104 FORMAT C ' FI CHI ER ',12) 

GO TO 300 
600 WRI TEC 108, 101 ) 

101 FORMAT C ' TRAVAIL TERM I NE ' ) 

150 FORMAT C13A4) 

250 FORMAT C2I 1 0 , 8F 1 2 . 2 , 3A4 ) 

152 FORMAT C30A4) 

252 FORMAT! 30F 12.0) 

154 FORMAT! 31 A4) 

254 FORMAT C31F12.2) 

STOP 

END 
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CPROGRAMME SOURCE RNOISE1 

ELIMINATION D UNE LIGNE DE MESURE MODANE 
A PARTI R DE FICHIERS 2 LIGNES 

FI CHI ER UTILISE DANS LE CALCUL DE CHAMP LOINTAIN 
DIMENSION TAB1 ( 50) , TAB2( 50) , I TAB C 6 ) , NPOI ( 1 5) 

EQUIVALENCE ( TAB1 ( 2 ) J I TAB ( 1 ) ) 

DATA NBPIST/8/ 

KF=0 
NDt = 1 
ND3 = 3 

10 READ ( 105, 101 , END=900 ) NBPT, (NPOI ( I ), 1=1 ,NBPT) 

101 FORMAT ( 1615) 

C BOUCLE SUR LES POINTS 

DO 5 L= 1 , NBPT 
NUMER= 1 
ND=ND1 +KF*3 
REWIND ND 
K0DR=0 

C LECTURE BLOC DE TETE 

600 READ(ND, 105, END=61 0) ( TAB1 ( I ) , I =1 , 50) 

1 05 FORMAT ( 50A4 ) 

I F ( I TAB ( 1 ) . NE . NPOI ( L ) ) GO TO 500 
I NDEX = I TAB ( 4 ) 

I Ft I NDEX . EQ. 3. OR. I NDEX . EQ. 4 . OR. I NDEX . EQ. 7 . OR . INDEX . EQ. 8 ) NUMER = NUME 
*R+ 1 ; GO TO 500 

WR1TECND3, 105) (TAB1 ( I ) , I =1 ,50) 

C LECTURE BLOCS SPECTRE 

DO 20 I A= 1 , ITABC5) 

READtND, 1 05, EN0=630) ( TAB2( I ), 1=1 ,50) 

20 WRI TE( ND3, 105) (TAB2( I ) , I =1 , 50) 

NUMER=NUMER+1 
GO TO 600 

500 DO 30 J=1, I TAB( 5) 

30 READtND, 105, END=620) ( TAB2 ( I ) , I =1 , 50) 

I F ( NUMER . LE. NBPI ST )G0 TO 600 
GO TO 5 
610 KODR= 1 

WRITE! 108, 1 02)K0DR 
STOP 

620 K0DR=2 

WRI TEC 108, 1 02 ) KODR 
STOP 

630 K0DR=3 

WR I TE ( 108, 1 02 ) KODR 

102 FORMAT ( 1 KODR • , 15) 

STOP 

5 CONTINUE 
KF=KF+1 
GO TO 10 
900 REWIND ND3 

WRITE( 108, 103) 

103 FORMAT ( ' TRAVAIL TERM I NE 1 ) 

STOP 

END 


172 



o o o 


CPROGRAMME SOURCE RNOISE12 

REGROUPEMENT DE 2 LI ONES DE MESURE MODANE 
A PARTI R DE FICHIERS 1 LIGNE 

FI CHI ER UTILISE DANS LE CALCUL DE LOCAL I SATON DE SOURCE 
DIMENSION TAB1 (50), TAB2(50) , I TAB (6) , NPOI (15) 

EQUIVALENCE ( TAB1 ( 2 ) , I TAB ( 1 ) ) 

DATA NBPIST/4/ 

KF = 0 
ND1 = 1 


ND2 = 2 
ND3 = 3 

10 READ ( 105, 101 , END =900 ) NBPT , (NPOI ( I ) , I =1 , NBPT) 
101 FORMAT (1615) 

C BOUCLE SUR LES POINTS 

DO 5 L= 1 , NBPT 

C BOUCLE SUR LES LI ONES 

DO 5 I L= 1 ,2 
NUMER= 1 

I F ( IL.EQ. 1 ) ND=ND1 +KF*3 
I F ( IL.EQ. 2)ND=ND2+KF*3 
REWIND ND 
50 K0DR=O 

C LECTURE BLOC DE TETE 

600 READ( ND, 1 05, END=61 0) ( TAB1 ( I ) , I = 1 , 50) 

105 FORMAT ( 50A4 ) 

I F ( I TAB ( 1 ) . NE . NPO I ( L ) ) GO TO 500 
WRI TE(ND3, 1 05) ( TAB1 ( I ) , I =1 , 50) 

C LECTURE BLOCS SPECTRE 

DO 20 I A= 1 , I TAB( 5) 

READ( ND, 1 05, END=630> ( TAB2C I ) , I =1 , 50) 

20 WRI TE(N03, 1 05) ( TAB2( I ) , I =1 , 50) 

NUMER=NUMER+ 1 

I F ( NUMER . LE . NBP I ST ) GO TO 50 
GO TO 5 

500 DO 30 J = 1 , I TAB( 5 ) 

30 READ(ND, 105, EN0=620) (TAB2( I ) , I =1 , 50) 

GO TO 600 
610 KODR= 1 

WR I TE ( 1 08, 1 02 ) KODR 
STOP 

620 K0DR=2 

WRI TE( 1 08, 1 02 ) KODR 
STOP 

630 K0DR= 3 

WRITE! 108, 1 02 ) KODR 

102 FORMAT ( ' KODR 1 , 15) 

STOP 

5 CONTINUE 
KF=KF+1 
GO TO 10 
900 REWIND ND3 

WRITE! 106, 103) 

103 FORMAT ( ' TRAVAIL TERM I NE 1 ) 

STOP 

END 
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CPROGRAMME SOURCE ECHN4LM 

REAL*8 DUMP ( 3446 ) j DUMP1 ( 1 32) , DUMP2(74) , DUMP3( 1800) , DUMP4(3500) 

REAL*8 XOVERD, THETAS, XDMAX, THETSM 

REAL*8 RNZDIA, VJET, FREQ 

REAL*8 STR, DFMAX, XPEAKN, XPEAKF 

REAL*8 PS! VAL, XDVAL, ST, STP, VJ3, VJ4, VAMB 

REAL *8 PS IS, XDN 

COMMON / I DENT/NPO I 

COMMON /TI TRE/LI B( 1 0) , I DATE! 3) 

COMMON /TABD/STR(33) , DFMAX ( 33 ) , XPEAKN ( 33 ), XPEAKF ( 33 ) 

COMMON /SUB/V J3 , FREQ ( 33 ) , THETAS (50,33), XOVERD (50,33), NTAB ( 33 ) , 
1 NTEST , XDMAX ( 33 ) , THETSM ( 33 ) , RNZD I A , NZTYPE (10), NFREQ 

C0MM0N/SUB2/ST ( 35 ) , STP (35) , I WT1 , I WT2, VAMB, VJ4 
C0MM0N/SUB3/PSI VAL(50) , XDVAL(50, 35) 

C0MM0N/SUB4/PS I S ( 50, 35) , XDN (50, 35) 

D I MENS ION LIB1(20),LIB2( 20 ) , L 1 BE (10), I DAT ( 3 ) 

DIMENSION XMOD ( 44 ) 

c* * * * # 


EQUIVALENCE ( DUMP ( 1 ) , VJ3 ) 

EQUIVALENCE ( DUMP1 ( 1 ) , STR( 1 ) ) 

EQUIVALENCE ( DUMP2 ( 1 ) , ST ( 1 ) ) 

EQUIVALENCE ( DUMP3 ( 1 ) , PS I VAL ( 1 ) ) 

EQUIVALENCE ( DUMP4 ( 1 ) , PS I S ( 1 , 1 ) ) 

PREPARATION DU TRACE 
DO 100 1=1,44 
XMOD( 1 )=0. 

100 CONTINUE 
NDT=69 

CALL OPENTR( NDT, XMOD) 

KPLANC=0 

C**»*« LECTURE OES DONNEES N0ISE4 
READ( 7) DUMP2 
READ( 7) DUMP3 
READ( 7) NPOI 
READ( 7) LIB 
READ(7) I DATE 
REWIND 7 

LECTURE DES DONNEES N0ISE3 
READ(8) DUMP 
READ( 8) DUMP1 
READ(8) NOP 
READ( 8) LIBE 
READ( 8) (DAT 
READ( 8) LIB1 
READ( 8 ) LIB2 
REWIND 8 
C****« TRACE 

DO 10 J=1 , 33 
DO 10 1=1,50 
THETAS( I , J)=PSIVAL( I ) 

10 XOVERD ( I , J ) =XDVAL ( I , J ) 

DO 20 J= 1 , 33 
20 NTAB ( J ) =50 
V JET = VJ3 

CALL TXSDN4 ( KPLANC , XOVERD, THETAS, NTAB, NFREQ, XDMAX, THETSM, RNZD I A 
1VJET, FREQ, LIB1 , LIB2, XMOD) 

C*»*** FIN DE TRACE 

CALL CLOSTR(XMOD) 

WRITE( 108, 2010) KPLANC 
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2010 FORMAT ( ///3X, ' NB . PLANCHES 3 ' , 13//) 

STOP 

END 

SUBROUTI NE TXSDN4 ( KPLANC , XOVERD, THETAS, NTAB, NFREQ, XDMAX, 
1 THETSM , RNZD I A , V JET , FREQ , L I B 1 , L l B2 , XMOD ) 

C** * * * SOUS -PROGRAMME DE TRACE DES COURBES X/D=F(PSIS) 

REAL *6 XOVERD ( 50, 33) , THETAS ( 50, 33) , XDMAX ( 33) , THETSM ( 33) 
REAL *8 RNZD I A, VJET, FREQ ( 33) , ST , STP 
COMMON / I DENT/NPO I 

COMMON /T I TRE/LI B( 1 0 ) , I DATEC 3) 

COMMON /TABD/STR( 33) , DFMAXC33) , XPEAKN(33) , XPEAKF( 33) 
C0MM0N/SUB2/ST ( 35 ) , STP ( 35 ) 

REAL*8 STR, DFMAX, XPEAKN, XPEAKF 
DIMENSION XMOD ( 1 ) , NTABC 1 ) , LI B1 ( 1 ) , L I B2( 1 ) 

Q* * * * * 

D I MENS I ON NAM ( 7 ) , NASA ( 5 ) , I PO I NT ( 2 ) , I DEG ( 1 ) 

DIMENSION I V ( 4 ) 

D I MENS I ON I THE ( 2) , I XSDC 1 ) , I FREQ ( 1 ) 

DIMENSION I ANG ( 7 ) , X I ANG ( 7 ) , I VALX ( 6 ) 

DIMENSION SXSDC50) , STHETAC50) 

DIMENSION I FI GC 1 ) 

DIMENSION X1212) , Y12C2) 

DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 

C# * * ## 

DATA 
DATA 
DATA 
DATA 
DATA 

C# * # * * 

c***** TRACE DE 2 COURBES PAR PLANCHE 
NBCT = 0 

DO 210 1 F= 1 , NFREQ 
I F ( NTAB ( IF) . EQ . 0 ) GO TO 210 
I FCNBCT . EQ. 1 ) GO TO 160 
C***** TRACE DU CADRE ET DU CARTOUCHE 
I F ( NBCT . EQ . 2 ) NBCT=0 
XT =10. 

YT= 1 0 . 

ANG=90 . 

NC = 28 

CALL TPL( CX, CY, XT, YT, ANG, NAM, NC, XMOD) 

K0DE=O 
NCL=40 
NC= 1 

CALL TCARTCKODE, CX, CY, LIB, NCL, I DATE, NC, XMOD) 
KPLANC=KPLANC+ 1 
ECRITURE NASA 
XT = 55 . 

YT=CY - 1 0 . 

HL = 3 . 

HH = 5 . 

ANG=0 . 


NAM/ ' PA- J . BRASSEUR ECH.N.A.S.A. V 

NASA/ ' N. A. S. A. /O . N. E. R. A. V 
I POINT/ 'POINT V 
I DEG/ ' DEG ' / 

IV/' VO ( FT/SEC )= V 

l ST1 / ' STO= ‘ / , I ST2/ ' ST = 1 /, I ST3/ ' STP= ' / 

I THE/ ' PSI-S '/.IXSD/'X/D 1 / , I FREQ/ ' FREQ ' / 

CX/210. /, CY/300 . / 

I ANG/40, 60, 80, 100, 1 20, 140, 1 60/ 

XIANG/47.25, 67.75,88.25, 108.75, 129.25,149.75, 1 70.25/ 
I VALX/O, 2, 4, 6, 8, 10/ 

I F 1 G/ 'FIG. '/ 
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NC= 1 9 

CALL KSTEP C 1 , 1 , 4 , 1 , XMOD ) 

CALL KTEXTE( XT, YT, HL, HH, NASA, ANG, NC, XMOD ) 

CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD ) 

C**#** ECRITURE DANS LA MARGE DE LIB1,LIB2 
HL=2 . 5 
HH=2. 5 
NC = 80 
ANG=90 . 

XT=6 . 5 
YT= 1 00 . 

CALL KTEXTE ( XT, YT, HL, HH, LIB1 , ANG, NC,XMOD) 

XT =16.5 

CALL KTEXTE (XT, YT, HL, HH, LIB2, ANG, NC, XMOD) 

C***** ECRITURE NPOI 
XT = 25 . 

YT = CY -28 . 

NC = 5 
HL = 3 . 

ANG=0 . 

HH=3 . 

CALL KTEXTE ( XT , Y T , HL , HH , I PO l NT , ANG , NC , XMOD ) 

C* * * * * 

XT =XT +18. 

NC = 4 

CALL KF I XE ( XT, YT, HL, HH, NPOI , ANG, NC,XMOD) 

C***** ECRITURE DE FIG. 

XT = 1 80 . 

NC=4 

CALL KTEXTE ( XT , YT, HL, HH, I F I G, ANG, NC , XMOD ) 

C*##*# TRACE DU PREMIER AXE VERT I CAL ( PART I E HAUTE DE LA PLANCHE) 
XT = 40 . 

YT = 1 30 . 

NC = 0 

PASMM=20 . 5 
ANG=90 . 

XM I N= 1 . 

PAS=1 . 

NGRAD=6 
NF = 0 

CALL KAXE ( XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
C***** TRACE DU SECOND AXE VERT I CAL ( PART | E BASSE DE LA PLANCHE) 
YT= 1 0 . 

CALL KAXE ( XT, YT, NORD, NC , PASMM , ANG , XM I N, PAS, NGRAD, NF, XMOD) 
C**#** TRACE DU PREMIER AXE HORIZONTAL 
XT=40 . 

YT= 1 30 . 

ANG=0 . 

PASMM = 1 0 . 25 
NGRAD= 1 5 

CALL KAXE (XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
C****# TRACE DU SECOND AXE HORIZONTAL 
YT =10. 

CALL KAXE(XT, YT, NORD, NC, PASMM, ANG, XMI N, PAS, NGRAD, NF, XMOD) 
C***** ECRITURE DES DOTATIONS SUR LES AXES HORIZONTAUX 
YT = 5 . 

ANG=0 . 

HL = 2 . 

HH = 2. 

NC = 3 
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DO 120 1=1,7 
XT”X I ANG ( I ) 

CALL KFIXE(XT,YT,HL,HH, I ANG( I) , ANG, NC, XMOD) 

120 CONTINUE 

XT = XT +10. 25 
NC = 3 

CALL KTEXTE(XT, YT, HL, HH, I DEG, ANG, NC, XMOD) 

YT =10. 

XT = 1 86 . 5 
NC = 7 

CALL KTEXTECXT, YT, HL, HH, I THE, ANG, NC, XMOD) 

YT=1 12. 

XT = 1 00 . 

NC= 1 3 

CALL KTEXTE(XT, YT, HL, HH, IV, ANG, NC, XMOD) 

XT=60 . 

NC= 3 

CALL KTEXTE ( XT , YT , HL , HH , I ST1 , ANG, NC, XMOD) 

CALiTkTEXTE ( XT , YT , HL , HH , I ST2 , ANG , NC , XMOD ) 
YT=YT-7 . 

CALL KTEXTE (XT, YT, HL, HH, I ST3, ANG, NC, XMOD) 

;***»* 

YT=1 25. 

NC=3 

DO 130 1=1,7 

XT=X I ANG ( I ) 

CALL KFIXEfXT, YT, HL, HH, 1 ANG ( I ) , ANG, NC, XMOD) 

130 CONTINUE 

XT = XT +10. 25 
NC = 3 

CALL KTEXTE(XT, YT, HL, HH, I DEG, ANG, NC, XMOD) 

YT = YT +5 . 

XT = 1 86 . 5 
NC = 7 

CALL KTEXTECXT, YT, HL, HH, I THE, ANG, NC, XMOD) 

YT = 240 . 

XT = 1 00 
NC= 1 3 

CALL KTEXTE (XT, YT, HL, HH, I V, ANG, NC, XMOD) 

XT=60 . 

NC = 3 

CALL KTEXTE ( XT, YT, HL, HH, I ST1 , ANG, NC, XMOD) 

CALLTKTEXTE ( XT, YT, HL, HH, I ST2, ANG, NC, XMOD) 
YT=YT-7. 

CALL KTEXTE(XT, YT, HL, HH, I ST3, ANG, NC, XMOD) 
ECRITURE DES COTATIONS SUR LES AXES VERTICAUX 
XT=32 . 

NC = 2 

YT =-10.5 
DO 140 1=1,6 
YT=YT+20 . 5 

CALL KFIXE(XT, YT, HL, HH, I VALX( 1 ) , ANG, NC, XMOD) 
140 CONTINUE 
XT = 21 . 

NC = 3 

CALL KTEXTE(XT, YT, HL, HH, I XSD, ANG, NC, XMOD) 

c* # # # # 

XT=32 . 


177 


YT= 1 09 . 5 
NC = 2 

DO 150 1=1,6 
YT = YT + 20 . 5 

CALL KFIXECXT, YT, HL, HH, I VALXC I ) , ANG, NC, XMOD) 

150 CONTINUE 
XT=2 1 . 

NC = 3 

CALL KTEXTECXT , YT, HL, HH, I XSD, ANG, NC, XMOD) 

C***«* CONVERSION EN SIMPLE PRECISION DE X/D ET THETA 
160 CONTINUE 

DO 170 1=1, NTAB (IF) 

SXSD ( I ) =SNGL ( XOVERD ( I , I F ) ) 

STHETA ( I ) =SNGL ( THETAS ( I , IF)) 

170 CONTINUE 

NBCT=NBCT+1 

c* * * * * 

IFCNBCT. EQ. 1 ) YT=240. ; GO TO 190 

YT=1 12. 

190 CONTINUE 
C***«* ECRITURE V JET 
XT = 1 40 . 

NC = 6 
HL = 2 . 

HH=2 . 

S=SNGL ( VJET ) 

CALL KDECI M(XT, YT, HL, HH, S, ANG, NC, XMOD ) 

C*****STROUHAL STATIQ. ET DYMAMIQ. 

XT=70 . 

NC=7 

S=SNGL(STR( IF) ) 

CALL KDEC I M(XT, YT, HL, HH,S, ANG, NC, XMOD) 

YT = YT-7 . 

S=SNGL(ST (IF) ) 

CALL KDECI M(XT, YT,HL,HH,S, ANG, NC, XMOD) 

YT = YT-7 . 

S = SNGL ( STP C IF) ) 

CALL KDECI M(XT,YT,HL, HH, S, ANG, NC,XMOD) 

C* * * * * 

TRACE EN POINTE DES COURBES 
CXSUJ1 =30. 

CXSUJ2= 1 70 . 

CYSUJ1 =-0.5 
CYSU J2= 1 0 . 

CXOB J 1 =40 . 

CXOB J2= 1 83 . 5 

I F ( NBCT . EQ . 1 ) CYOB J 1=124. 875 ; CY0BJ2=232.5 : GO TO 200 
CY0BJ1 =4.875 
CYOB J2= 1 12.5 
200 CONTINUE 

CALL DEPLAC ( 0 . , XMOD ) 

CALL D I MSU J ( CXSU J 1 , CXSUJ2, CYSUJ1 , CYSUJ2, XMOD) 

CALL DIM0BJCCX0BJ1 , CX0BJ2, CYOB J 1 , CYOB J2, XMOD ) 

NBPT=NTAB ( IF) 

CALL KSTEP C - 1 6, 1 , 1 , 1 , XMOD ) 

CALL KPO I NT ( STHETA , SXSD , NBPT , XMOD ) 

CALL KSTEP ( 1 , 1 , 1 , 1 , XMOD) 

IFCNBCT. NE. 2) GO TO 220 
CCX=CX+20. 

CALL DEPLAC (CCX, XMOD) 
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GO TO 210 
CONTINUE 

CALL DEPLAC ( 0 . , XMOD ) 

CALL D I MSU J ( 0 . , CX , 0, ,CY, XMOD ) 
CALL D I MOB J ( 0 . j CX , 0 . j CY , XMOD ) 
210 CONTINUE 

I F ( NDCT . EQ . 2 ) RETURN 
CCX=CX+20. 

CALL DEPLAC (CCX, XMOD) 

RETURN 

END 
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Noise from a J-85 turbojet with a conical convergent nozzle was measured in simulated flight in the ONERA SI Wind Tunnel Data are 
presented for several flight speeds up to 130 m/sec and for radiation angles of 40° to 160° relative to the upstream direction. The jet was oper- 
ated with subsonic and sonic exhaust speeds. A moving microphone on a 2-m sideline was used to survey the radiated sound field in die 
acoustically t reated, closed test section. The data were extrapolated to a 122-m sideline by means of a multiple-sideline source-location 
method, which was used to identify the acoustic source regions, directivity patterns, and near field effects. The source-location method is 
described along with its advantages and disadvantages. 

Results indicate that the effects of simulated flight on J-85 noise are significant. At die maximum forward speed of 130 m/sec, the peak 
overall sound levels in the aft quadrant were attenuated approximately 10 dB relative to sound levels of the engine operated statically. As 
expected, the simulated flight and static data tended to merge in the forward quadrant as the radiation angle approached 40°. There is evidence 
that internal engine or shock noise was important in the forward quadrant The data are compared with published predictions for flight effects 
on pure jet noise and internal engine noise. A new empirical prediction is presented that relates the variation of internally generated engine 
noise or broadband shock noise to forward speed. Measured near field noise extrapolated to far field agrees reasonably well with data from 
similar engines tested statically outdoors, in flyover, in a wind tunnel, and on the Berlin Aero train. Anomalies in the results for the forward 
quadrant and for angles above 140° are discussed. 

The multiple-sideline method proved to be cumbersome in this application, and it did not resolve all of the uncertainties associated with 
measurements of jet noise close to the jet The simulation was complicated by wind-tunnel background noise and the propagation of low- 
frequency sound around the circuit. 
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